Làm cách nào để tạo kích thước ô trong bản đồ nhiệt làm trung gian giải quyết dữ liệu bằng R?

Question

Với ví dụ sau:

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) 

Một Heatmap (heatmap(X, Rowv=NA, Colv=NA, col=rev(heat.colors(256)))) sẽ trông giống như:

Bây giờ, nói rằng các biến trên các trục là các thông số ảnh hưởng đến một số chức năng, khoảng cách giữa 3 và 4 nhỏ hơn khoảng cách giữa 1 và 3 và tôi muốn kích thước ô của bản đồ nhiệt phản ánh điều này. Làm cách nào để tạo bản đồ nhiệt nơi kích thước ô phản ánh độ phân giải của dữ liệu đã biết?

Tôi đang nghĩ đến cái gì đó trông một chút như thế này:

Do thư viện để tạo một cái gì đó như thế này tồn tại? Nếu không, có phải vì tôi đang thiếu gì đó không? Nếu có thì sao?

Answer 1

Trong một set of functions Cá nhân tôi sử dụng, tôi có một chức năng để vẽ biểu đồ hai chiều mà bạn có thể sử dụng. Tôi đã bao gồm mã bên dưới:

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

Ví dụ bạn kết quả này trong:

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

Sửa

Dưới đây là một chức năng thô tạo ra một huyền thoại màu :

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

Bạn có thể thêm huyền thoại này để âm mưu của bạn sử dụng 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) 

... thích nghi với nhu cầu

Chỉnh sửa 2

của bạn Trong đoạn mã gốc của histplot2 có một dòng h <- h/(wx*wy) mà tôi hiện có bỏ qua. Điều này chia các giá trị của biểu đồ theo diện tích của thùng, thường là những gì bạn muốn, nhưng có lẽ không phải trong trường hợp này.

Answer 2

Một cái gì đó như thế này, có thể?

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