Jak mogę zmienić rozmiar komórki w termoparowej rozdzielczości danych mediacji za pomocą R?

Question

Biorąc pod uwagę następujący przykład:

X <- matrix(nrow=3, ncol=3) 
X[1,] <- c(0.3, 0.4, 0.45) 
X[2,] <- c(0.3, 0.7, 0.65) 
X[3,] <- c(0.3, 0.4, 0.45) 
colnames(X)<-c(1.5, 3, 4) 
rownames(X)<-c(1.5, 3, 4) 

termiczna (heatmap(X, Rowv=NA, Colv=NA, col=rev(heat.colors(256)))) będzie wyglądać następująco:

Teraz, powiedzmy, że zmienne na osiach są parametry wpływające na jakąś funkcję, odległość między 3 i 4 jest mniejsze niż odległość między 1 a 3 i chciałbym, żeby wielkość komórki mapy ciepła odzwierciedlała to. Jak mogę utworzyć mapę cieplną, w której rozmiar komórki odzwierciedla rozdzielczość znanych danych?

Mam na myśli coś, co wygląda nieco jak poniżej:

uwagi bibliotek do tworzenia coś takiego istnieje? Jeśli nie, czy to dlatego, że czegoś brakuje? Jeśli tak to co?

Answer 1

Ja osobiście używam funkcji set of functions do rysowania dwuwymiarowych histogramów, które można wykorzystać. Mam włączone poniższy kod:

#' Plot two dimensional histogram 
#' 
#' @param hist matrix or two dimensional array containing the number of counts 
#' in each of the bins. 
#' @param borders_x the x-borders of the bins in the histogram. Should be a 
#' numeric vector with lenght one longer than the number of columns of 
#' \code{hist} 
#' @param borders_y the y-borders of the bins in the histogram. Should be a 
#' numeric vector with lenght one longer than the number of rows of 
#' \code{hist} 
#' @param type a character specifying the type of plot. Valid values are "text", 
#' "area" and "color". See details for more information. 
#' @param add add the plot to an existing one or create a new plot. 
#' @param add_lines logical specifying whether or not lines should be drawn 
#' between the bins. 
#' @param draw_empty if \code{FALSE} empty bins (numer of counts equal to zero) 
#' are not drawn. They are shown using the background color. 
#' @param col for types "area" and "text" the color of the boxes and text. 
#' @param line_col the color of the lines between the bins. 
#' @param background_col the background color of the bins. 
#' @param lty the line type of the lines between the bins. 
#' @param text_cex the text size used for type "text". See \code{\link{par}} for 
#' more information. 
#' @param col_range the color scale used for type "color". Should be a function 
#' which accepts as first argument the number of colors that should be 
#' generated. The first color generated is used for the zero counts; the 
#' last color for the highest number of counts in the histogram. 
#' @param ... additional arguments are passed on to \code{\link{plot}}. 
#' 
#' @details 
#' There are three plot types: "area", "text", and "color". In case of "area" 
#' rectangles are drawn inside the bins with area proportional to the number of 
#' counts in the bins. In case of text the number of counts is shown as text in 
#' the bins. In case of color a color scale is used (by default heat.colors) to 
#' show the number of counts. 
#' 
#' @seealso \code{\link{image}} which can be used to create plots similar to 
#' type "color". \code{\link{contour}} may also be of interest. 
#' 
#' @examples 
#' histplot2(volcano - min(volcano), type="color") 
#' histplot2(volcano - min(volcano), add_lines=FALSE, type="area") 
#' histplot2(volcano - min(volcano), type="text", text_cex=0.5) 
#' 
#' @export 
histplot2 <- function(hist, borders_x=seq(0, ncol(hist)), 
     borders_y=seq(0, nrow(hist)), type="area", add=FALSE, add_lines=TRUE, 
     draw_empty=FALSE, col="black", line_col="#00000030", 
     background_col="white", lty=1, text_cex=0.6, col_range=heat.colors, ...) { 
    # create new plot 
    rangex <- c(min(borders_x), max(borders_x)) 
    rangey <- c(min(borders_y), max(borders_y)) 
    if (add == FALSE) { 
     plot(rangex, rangey, type='n', xaxs='i', yaxs='i', ...) 
     rect(rangex[1], rangey[1], rangex[2], rangey[2], col=background_col, 
      border=NA) 
    } 
    # prepare data 
    nx <- length(borders_x)-1 
    ny <- length(borders_y)-1 
    wx <- rep(diff(borders_x), each=ny) 
    wy <- rep(diff(borders_y), times=nx) 
    sx <- 0.95*min(wx)/sqrt(max(hist)) 
    sy <- 0.95*min(wy)/sqrt(max(hist)) 
    x <- rep((borders_x[-length(borders_x)] + borders_x[-1])/2, each=ny) 
    y <- rep((borders_y[-length(borders_y)] + borders_y[-1])/2, times=nx) 
    h <- as.numeric(hist) 
    # plot type "area" 
    if (type == "area") { 
     dx <- sqrt(h)*sx*0.5 
     dy <- sqrt(h)*sy*0.5 
     rect(x-dx, y-dy, x+dx, y+dy, col=col, border=NA) 
    # plot type "text" 
    } else if (type == "text") { 
     if (draw_empty) { 
      text(x, y, format(h), cex=text_cex, col=col) 
     } else { 
      text(x[h!=0], y[h!=0], format(h[h!=0]), cex=text_cex, col=col) 
     } 
    # plot type "color" 
    } else if (type == "color" | type == "colour") { 
     #h <- h/(wx*wy) 
     col <- col_range(200) 
     col <- col[floor(h/max(h)*200*(1-.Machine$double.eps))+1] 
     sel <- rep(TRUE, length(x)) 
     if (!draw_empty) sel <- h > 0 
     rect(x[sel]-wx[sel]/2, y[sel]-wy[sel]/2, x[sel]+wx[sel]/2, 
      y[sel]+wy[sel]/2, col=col[sel], border=NA) 
    } else { 
     stop("Unknown plot type: options are 'area', 'text' and 'color'.") 
    } 
    # add_lines 
    if (add_lines) { 
     lines(rbind(borders_x, borders_x, NA), 
      rbind(rep(rangey[1], nx+1), rep(rangey[2], nx+1), NA), 
      col=line_col, lty=lty) 
     lines(rbind(rep(rangex[1], ny+1), rep(rangex[2], ny+1), NA), 
      rbind(borders_y, borders_y, NA), col=line_col, lty=lty) 
    } 
    # add border 
    if (add == FALSE) box() 
} 

Dla Twojej przykład powoduje:

X <- matrix(nrow=3, ncol=3) 
X[1,] <- c(0.3, 0.4, 0.45) 
X[2,] <- c(0.3, 0.7, 0.65) 
X[3,] <- c(0.3, 0.4, 0.45) 
centers <- c(1.5, 3, 4) 

centers_to_borders <- function(centers) { 
    nc <- length(centers) 
    d0 <- centers[2]-centers[1] 
    d1 <- centers[nc]-centers[nc-1] 
    c(centers[1]-d0/2, 
     (centers[2:nc] + centers[1:(nc-1)])/2, centers[nc]+d1/2) 
} 

histplot2(X, centers_to_borders(centers), 
    centers_to_borders(centers), type="color") 

Edytuj

Poniżej jest szorstka funkcja, która tworzy legendę kolorów :

plot_range <- function(hist, col_range = heat.colors) { 
    r <- range(c(0, X)) 
    par(cex=0.7, mar=c(8, 1, 8, 2.5)) 
    plot(0, 0, type='n', xlim=c(0,1), ylim=r, xaxs='i', 
     yaxs='i', bty='n', xaxt='n', yaxt='n', xlab='', ylab='') 
    axis(4) 
    y <- seq(r[1], r[2], length.out=200) 
    yc <- floor(y/max(y)*5*(1-.Machine$double.eps))+1 
    col <- col_range(5)[yc] 
    b <- centers_to_borders(y) 
    rect(rep(0, length(y)), b[-length(b)], rep(1, length(y)), 
     b[-1], col=col, border=NA) 
} 

Można dodać tę legendę na Twój działka przy użyciu layout:

layout(matrix(c(1,2), nrow = 1), widths = c(0.9, 0.1)) 
par(mar = c(5, 4, 4, 2) + 0.1) 
histplot2(X, centers_to_borders(centers), 
    centers_to_borders(centers), type="color") 
plot_range(X) 

... dostosować do potrzeb

Edycja 2

W oryginalnym kodzie z histplot2 była linia h <- h/(wx*wy), którą teraz mam pominięty. To podzieliło wartości histogramu na obszar pojemnika, który często jest tym, czego potrzebujesz, ale prawdopodobnie nie w tym przypadku.

Answer 2

Coś w tym stylu, może?

library(ggplot2) 
library(reshape2) 

X <- matrix(nrow=3, ncol=3) 
X[1,] <- c(0.3, 0.4, 0.45) 
X[2,] <- c(0.3, 0.7, 0.65) 
X[3,] <- c(0.3, 0.4, 0.45) 


colnames(X)<-c(1.5, 3, 4) 
rownames(X)<-c(1.5, 3, 4) 
X <- melt(X) 
X <- as.data.frame(X) 
names(X) <- c("Var1", "Var2", "value") 
v1m <- unique(X$Var1) 
X$Var1.min <- rep(c(0, v1m[-length(v1m)]), length.out = length(v1m)) 
v2m <- unique(X$Var2) 
X$Var2.min <- rep(c(0, v2m[-length(v2m)]), each = length(v2m)) 

ggplot(data = X, aes(fill = value)) + 
    geom_rect(aes(ymin = Var1.min, ymax = Var1, xmin = Var2.min, xmax = Var2))