Come posso rendere la dimensione della cella in una mappa di calore mediazione dei dati utilizzando R?

Question

Dato il seguente esempio:

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) 

Una mappa termica (heatmap(X, Rowv=NA, Colv=NA, col=rev(heat.colors(256)))) sarà simile:

Ora, dire che le variabili sugli assi sono parametri che influenzano qualche funzione, la distanza tra 3 e 4 è più piccola della distanza tra 1 e 3 e vorrei che le dimensioni della cella della mappa di calore riflettessero questo. Come posso creare una mappa termica in cui le dimensioni della cella riflettono la risoluzione dei dati noti?

Sto pensando a qualcosa che sembra un po 'come questo:

fare le librerie per la creazione di qualcosa di simile esiste? Se no, è perché mi manca qualcosa? E allora?

Answer 1

In un set of functions Personalmente uso, ho una funzione per disegnare istogrammi bidimensionali che è possibile utilizzare. Ho incluso il codice qui sotto:

#' 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() 
} 

Per esempio, questo si traduce in:

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") 

Modifica

Qui di seguito è una funzione di massima che crea una legenda dei colori :

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) 
} 

Si potrebbe aggiungere questa leggenda alla trama utilizzando 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) 

... regolare al vostro bisogno

Edit 2

Nel codice originale di histplot2 c'era una riga h <- h/(wx*wy) che ora ho c ommentato. Questo ha diviso i valori dell'istogramma dall'area del cestino, che è spesso ciò che si desidera, ma probabilmente non in questo caso.

Answer 2

Qualcosa come questo, forse?

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))