r - 如何使用R使热图中的像元大小调节数据分辨率？

Question

给出以下示例:

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)

热图(heatmap(X, Rowv=NA, Colv=NA, col=rev(heat.colors(256))))如下所示:

现在，假设轴上的变量是影响某些功能的参数，3和4之间的距离小于1和3之间的距离，我希望热图的像元大小能够反射(reflect)这一点。如何在单元格大小反射(reflect)已知数据的分辨率的情况下制作热图？

我在想一些看起来像这样的东西:

是否存在用于创建此类内容的库？如果不是，那是因为我错过了什么吗？如果是这样，该怎么办？

Answer 1

在我个人使用的set of functions中，我具有绘制二维直方图的功能。我已包含以下代码:

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

对于您的示例，结果为:

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

编辑

以下是创建颜色图例的粗略函数:

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

您可以使用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)

...根据您的需要进行调整

编辑2

在histplot2的原始代码中，有一行h <- h/(wx*wy)，我现在已将其注释掉。这通过柱状图的区域来划分直方图的值，这通常是您想要的，但在这种情况下可能不是。