给定以下示例：
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 之间的距离，我希望热图的单元格大小能够反映这一点。如何制作热图，其中单元格大小反映已知数据的分辨率？
我在想一些看起来像这样的东西：
是否存在用于创建此类内容的库？如果没有，是不是因为我错过了什么？如果是这样，是什么？
在我个人使用的一组函数中，我有一个可以绘制二维直方图的函数。我已包含以下代码：
#' 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)我现在已经注释掉了。这将直方图的值除以 bin 的面积，这通常是您想要的，但在这种情况下可能不是。
像这样的东西，也许？
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))
