如何在统计热图中使用图形参数 (par/mtext)？
How to use graphical parameters (par/mtext) in the stats heatmap?
这是我想在热图中显示的数据：
structure(c(0.275131583482786, 0.313534037727115, 0.962898063173055, 0.370113551736794, 1.14085845291068, 1.02395544767755, 0.610512768755584, 0.992090676567594, 1.01157287717658, 0.679398973271326, 1.28114204694855, 0.963474557283888, 0.963249806395876, 0.952350396411827, 0.917066806607197, 0.721011695495292, 0.621362668286169, 0.905890374647831, 1.2375342589893, 0.80959426908998, 0.89503844823737, 1.33699982243824, 1.00649486312353, 0.897702695054227, 1.47859465133637, 1.00649486312353, 0.896753478691479), .Dim = c(3L, 9L), .Dimnames = list(c("Connectivity", "Dunn", "Silhouette"), c("2", "3", "4", "5", "6", "7", "8", "9", "10")), "`scaled:scale`" = structure(c(19.2058175118873, 0.0166116998686644, 0.748614066120069), .Names = c("Connectivity", "Dunn", "Silhouette")))
这是我的热图函数：
par(mar=c(5,5,5,5), cex=.4)
vhm<-heatmap(vkm,Rowv = NA,Colv = NA,
main="Ionospheric Reflection Variance")
mtext("K-Means Cluster Size Analysis: 2-10")
它是这样的：
我想改变：
- 边距：如何在图的顶部和底部之间获得等量的 space？现在主标题正对着window的顶部，而底部有太多space。
- 文本大小: 行名太大了。
- 副标题: 我想把它放在主标题下面。
- 文本位置: 我希望行名在左边，列名在右边。
我不确定为什么似乎没有按预期工作，我猜是因为该图来自统计数据包，而不是 doc says it's building the plot with the graphics package。
如何使用热图获得 par 和 mtext？
通过调整 heatmap 的源代码，有一个肮脏但不是快速的解决方案。不灵活但需要一点努力：
- 见以下代码注释a；
cexRow 和 cexCol;- 调整
line;
- 将行轴的一侧更改为右侧（请参阅以下代码中的注释 b）；
修改后的函数：
heatmap <- function (x,
Rowv = NULL,
Colv = if (symm) "Rowv" else NULL,
distfun = dist,
hclustfun = hclust,
reorderfun = function(d, w) reorder(d, w),
add.expr,
symm = FALSE,
revC = identical(Colv, "Rowv"),
scale = c("row", "column", "none"),
na.rm = TRUE,
margins = c(5, 5),
ColSideColors,
RowSideColors,
cexRow = 0.2 +
1 / log10(nr),
cexCol = 0.2 + 1 / log10(nc),
labRow = NULL,
labCol = NULL,
main = NULL,
xlab = NULL,
ylab = NULL,
keep.dendro = FALSE,
verbose = getOption("verbose"),
...)
{
scale <- if (symm && missing(scale))
"none"
else match.arg(scale)
if (length(di <- dim(x)) != 2 || !is.numeric(x))
stop("'x' must be a numeric matrix")
nr <- di[1L]
nc <- di[2L]
if (nr <= 1 || nc <= 1)
stop("'x' must have at least 2 rows and 2 columns")
if (!is.numeric(margins) || length(margins) != 2L)
stop("'margins' must be a numeric vector of length 2")
doRdend <- !identical(Rowv, NA)
doCdend <- !identical(Colv, NA)
if (!doRdend && identical(Colv, "Rowv"))
doCdend <- FALSE
if (is.null(Rowv))
Rowv <- rowMeans(x, na.rm = na.rm)
if (is.null(Colv))
Colv <- colMeans(x, na.rm = na.rm)
if (doRdend) {
if (inherits(Rowv, "dendrogram"))
ddr <- Rowv
else {
hcr <- hclustfun(distfun(x))
ddr <- as.dendrogram(hcr)
if (!is.logical(Rowv) || Rowv)
ddr <- reorderfun(ddr, Rowv)
}
if (nr != length(rowInd <- order.dendrogram(ddr)))
stop("row dendrogram ordering gave index of wrong length")
}
else rowInd <- 1L:nr
if (doCdend) {
if (inherits(Colv, "dendrogram"))
ddc <- Colv
else if (identical(Colv, "Rowv")) {
if (nr != nc)
stop("Colv = \"Rowv\" but nrow(x) != ncol(x)")
ddc <- ddr
}
else {
hcc <- hclustfun(distfun(if (symm)
x
else t(x)))
ddc <- as.dendrogram(hcc)
if (!is.logical(Colv) || Colv)
ddc <- reorderfun(ddc, Colv)
}
if (nc != length(colInd <- order.dendrogram(ddc)))
stop("column dendrogram ordering gave index of wrong length")
}
else colInd <- 1L:nc
x <- x[rowInd, colInd]
labRow <- if (is.null(labRow))
if (is.null(rownames(x)))
(1L:nr)[rowInd]
else rownames(x)
else labRow[rowInd]
labCol <- if (is.null(labCol))
if (is.null(colnames(x)))
(1L:nc)[colInd]
else colnames(x)
else labCol[colInd]
if (scale == "row") {
x <- sweep(x, 1L, rowMeans(x, na.rm = na.rm), check.margin = FALSE)
sx <- apply(x, 1L, sd, na.rm = na.rm)
x <- sweep(x, 1L, sx, "/", check.margin = FALSE)
}
else if (scale == "column") {
x <- sweep(x, 2L, colMeans(x, na.rm = na.rm), check.margin = FALSE)
sx <- apply(x, 2L, sd, na.rm = na.rm)
x <- sweep(x, 2L, sx, "/", check.margin = FALSE)
}
lmat <- rbind(c(NA, 3), 2:1)
lwid <- c(if (doRdend) 1 else 0.05, 4)
lhei <- c((if (doCdend) 1 else 0.05) + if (!is.null(main)) 0.2 else 0,
4)
if (!missing(ColSideColors)) {
if (!is.character(ColSideColors) || length(ColSideColors) !=
nc)
stop("'ColSideColors' must be a character vector of length ncol(x)")
lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1)
lhei <- c(lhei[1L], 0.2, lhei[2L])
}
if (!missing(RowSideColors)) {
if (!is.character(RowSideColors) || length(RowSideColors) !=
nr)
stop("'RowSideColors' must be a character vector of length nrow(x)")
lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1),
1), lmat[, 2] + 1)
lwid <- c(lwid[1L], 0.2, lwid[2L])
}
lmat[is.na(lmat)] <- 0
if (verbose) {
cat("layout: widths = ", lwid, ", heights = ", lhei,
"; lmat=\n")
print(lmat)
}
dev.hold()
on.exit(dev.flush())
op <- par(no.readonly = TRUE)
on.exit(par(op), add = TRUE)
layout(lmat, widths = lwid, heights = lhei, respect = TRUE)
if (!missing(RowSideColors)) {
par(mar = c(margins[1L], 0, 0, 0.5))
image(rbind(if (revC)
nr:1L
else 1L:nr), col = RowSideColors[rowInd], axes = FALSE)
}
if (!missing(ColSideColors)) {
par(mar = c(0.5, 0, 0, margins[2L]))
image(cbind(1L:nc), col = ColSideColors[colInd], axes = FALSE)
}
# -------------------------- a -----------------------
# plot main figure
# the following line controls margins around
par(mar = c(margins[1L], 5, 5, margins[2L]))
if (!symm || scale != "none")
x <- t(x)
if (revC) {
iy <- nr:1
if (doRdend)
ddr <- rev(ddr)
x <- x[, iy]
}
else iy <- 1L:nr
image(1L:nc, 1L:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 +
c(0, nr), axes = FALSE, xlab = "", ylab = "", ...)
axis(1, 1L:nc, labels = labCol, las = 2, line = -0.5, tick = 0,
cex.axis = cexCol)
if (!is.null(xlab))
mtext(xlab, side = 1, line = margins[1L] - 1.25)
# ----------------------- b --------------------------------
# which side to plot rownames: right = 2
axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0,
cex.axis = cexRow)
if (!is.null(ylab))
# remember to change this to 2 as well
mtext(ylab, side = 2, line = margins[2L] - 1.25)
if (!missing(add.expr))
eval.parent(substitute(add.expr))
# plot row dendro
par(mar = c(margins[1L], 0, 0, 0))
if (doRdend)
plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none")
else frame()
# plot col dendro
par(mar = c(0, 0, if (!is.null(main)) 1 else 0, margins[2L]))
if (doCdend)
plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none")
else if (!is.null(main))
frame()
# title
if (!is.null(main)) {
par(xpd = NA, mar = c(0, 0, 1, 0))
title(main, cex.main = 1.5 * op[["cex.main"]])
}
invisible(list(rowInd = rowInd, colInd = colInd,
Rowv = if (keep.dendro && doRdend) ddr,
Colv = if (keep.dendro && doCdend) ddc))
}
绘制热图：
heatmap(
vkm,
Rowv = NA,
Colv = NA,
cexRow = 1,
cexCol = 1,
margins = c(3, 5),
main = "Ionospheric Reflection Variance"
)
mtext("K-Means Cluster Size Analysis: 2-10", line = 0)
图中是这样的：
然而，这可以通过 ggplot2::geom_raster:
更灵活地完成
library(ggplot2)
df <- expand.grid(
vars = rownames(vkm),
cols = colnames(vkm)
)
df$value <- c(vkm)
ggplot(df, aes(x = cols, y = vars)) +
geom_raster(aes(fill = value)) +
scale_fill_gradient(low = 'red', high = 'yellow') +
ggtitle(bquote(
atop("Ionospheric Reflection Variance",
atop("K-Means Cluster Size Analysis: 2-10")))) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank()
)
结果是：
这是我想在热图中显示的数据：
structure(c(0.275131583482786, 0.313534037727115, 0.962898063173055, 0.370113551736794, 1.14085845291068, 1.02395544767755, 0.610512768755584, 0.992090676567594, 1.01157287717658, 0.679398973271326, 1.28114204694855, 0.963474557283888, 0.963249806395876, 0.952350396411827, 0.917066806607197, 0.721011695495292, 0.621362668286169, 0.905890374647831, 1.2375342589893, 0.80959426908998, 0.89503844823737, 1.33699982243824, 1.00649486312353, 0.897702695054227, 1.47859465133637, 1.00649486312353, 0.896753478691479), .Dim = c(3L, 9L), .Dimnames = list(c("Connectivity", "Dunn", "Silhouette"), c("2", "3", "4", "5", "6", "7", "8", "9", "10")), "`scaled:scale`" = structure(c(19.2058175118873, 0.0166116998686644, 0.748614066120069), .Names = c("Connectivity", "Dunn", "Silhouette")))
这是我的热图函数：
par(mar=c(5,5,5,5), cex=.4)
vhm<-heatmap(vkm,Rowv = NA,Colv = NA,
main="Ionospheric Reflection Variance")
mtext("K-Means Cluster Size Analysis: 2-10")
它是这样的：
我想改变：
- 边距：如何在图的顶部和底部之间获得等量的 space？现在主标题正对着window的顶部，而底部有太多space。
- 文本大小: 行名太大了。
- 副标题: 我想把它放在主标题下面。
- 文本位置: 我希望行名在左边，列名在右边。
我不确定为什么似乎没有按预期工作，我猜是因为该图来自统计数据包，而不是 doc says it's building the plot with the graphics package。
如何使用热图获得 par 和 mtext？
通过调整 heatmap 的源代码，有一个肮脏但不是快速的解决方案。不灵活但需要一点努力：
- 见以下代码注释a；
cexRow和cexCol;- 调整
line; - 将行轴的一侧更改为右侧（请参阅以下代码中的注释 b）；
修改后的函数：
heatmap <- function (x,
Rowv = NULL,
Colv = if (symm) "Rowv" else NULL,
distfun = dist,
hclustfun = hclust,
reorderfun = function(d, w) reorder(d, w),
add.expr,
symm = FALSE,
revC = identical(Colv, "Rowv"),
scale = c("row", "column", "none"),
na.rm = TRUE,
margins = c(5, 5),
ColSideColors,
RowSideColors,
cexRow = 0.2 +
1 / log10(nr),
cexCol = 0.2 + 1 / log10(nc),
labRow = NULL,
labCol = NULL,
main = NULL,
xlab = NULL,
ylab = NULL,
keep.dendro = FALSE,
verbose = getOption("verbose"),
...)
{
scale <- if (symm && missing(scale))
"none"
else match.arg(scale)
if (length(di <- dim(x)) != 2 || !is.numeric(x))
stop("'x' must be a numeric matrix")
nr <- di[1L]
nc <- di[2L]
if (nr <= 1 || nc <= 1)
stop("'x' must have at least 2 rows and 2 columns")
if (!is.numeric(margins) || length(margins) != 2L)
stop("'margins' must be a numeric vector of length 2")
doRdend <- !identical(Rowv, NA)
doCdend <- !identical(Colv, NA)
if (!doRdend && identical(Colv, "Rowv"))
doCdend <- FALSE
if (is.null(Rowv))
Rowv <- rowMeans(x, na.rm = na.rm)
if (is.null(Colv))
Colv <- colMeans(x, na.rm = na.rm)
if (doRdend) {
if (inherits(Rowv, "dendrogram"))
ddr <- Rowv
else {
hcr <- hclustfun(distfun(x))
ddr <- as.dendrogram(hcr)
if (!is.logical(Rowv) || Rowv)
ddr <- reorderfun(ddr, Rowv)
}
if (nr != length(rowInd <- order.dendrogram(ddr)))
stop("row dendrogram ordering gave index of wrong length")
}
else rowInd <- 1L:nr
if (doCdend) {
if (inherits(Colv, "dendrogram"))
ddc <- Colv
else if (identical(Colv, "Rowv")) {
if (nr != nc)
stop("Colv = \"Rowv\" but nrow(x) != ncol(x)")
ddc <- ddr
}
else {
hcc <- hclustfun(distfun(if (symm)
x
else t(x)))
ddc <- as.dendrogram(hcc)
if (!is.logical(Colv) || Colv)
ddc <- reorderfun(ddc, Colv)
}
if (nc != length(colInd <- order.dendrogram(ddc)))
stop("column dendrogram ordering gave index of wrong length")
}
else colInd <- 1L:nc
x <- x[rowInd, colInd]
labRow <- if (is.null(labRow))
if (is.null(rownames(x)))
(1L:nr)[rowInd]
else rownames(x)
else labRow[rowInd]
labCol <- if (is.null(labCol))
if (is.null(colnames(x)))
(1L:nc)[colInd]
else colnames(x)
else labCol[colInd]
if (scale == "row") {
x <- sweep(x, 1L, rowMeans(x, na.rm = na.rm), check.margin = FALSE)
sx <- apply(x, 1L, sd, na.rm = na.rm)
x <- sweep(x, 1L, sx, "/", check.margin = FALSE)
}
else if (scale == "column") {
x <- sweep(x, 2L, colMeans(x, na.rm = na.rm), check.margin = FALSE)
sx <- apply(x, 2L, sd, na.rm = na.rm)
x <- sweep(x, 2L, sx, "/", check.margin = FALSE)
}
lmat <- rbind(c(NA, 3), 2:1)
lwid <- c(if (doRdend) 1 else 0.05, 4)
lhei <- c((if (doCdend) 1 else 0.05) + if (!is.null(main)) 0.2 else 0,
4)
if (!missing(ColSideColors)) {
if (!is.character(ColSideColors) || length(ColSideColors) !=
nc)
stop("'ColSideColors' must be a character vector of length ncol(x)")
lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1)
lhei <- c(lhei[1L], 0.2, lhei[2L])
}
if (!missing(RowSideColors)) {
if (!is.character(RowSideColors) || length(RowSideColors) !=
nr)
stop("'RowSideColors' must be a character vector of length nrow(x)")
lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1),
1), lmat[, 2] + 1)
lwid <- c(lwid[1L], 0.2, lwid[2L])
}
lmat[is.na(lmat)] <- 0
if (verbose) {
cat("layout: widths = ", lwid, ", heights = ", lhei,
"; lmat=\n")
print(lmat)
}
dev.hold()
on.exit(dev.flush())
op <- par(no.readonly = TRUE)
on.exit(par(op), add = TRUE)
layout(lmat, widths = lwid, heights = lhei, respect = TRUE)
if (!missing(RowSideColors)) {
par(mar = c(margins[1L], 0, 0, 0.5))
image(rbind(if (revC)
nr:1L
else 1L:nr), col = RowSideColors[rowInd], axes = FALSE)
}
if (!missing(ColSideColors)) {
par(mar = c(0.5, 0, 0, margins[2L]))
image(cbind(1L:nc), col = ColSideColors[colInd], axes = FALSE)
}
# -------------------------- a -----------------------
# plot main figure
# the following line controls margins around
par(mar = c(margins[1L], 5, 5, margins[2L]))
if (!symm || scale != "none")
x <- t(x)
if (revC) {
iy <- nr:1
if (doRdend)
ddr <- rev(ddr)
x <- x[, iy]
}
else iy <- 1L:nr
image(1L:nc, 1L:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 +
c(0, nr), axes = FALSE, xlab = "", ylab = "", ...)
axis(1, 1L:nc, labels = labCol, las = 2, line = -0.5, tick = 0,
cex.axis = cexCol)
if (!is.null(xlab))
mtext(xlab, side = 1, line = margins[1L] - 1.25)
# ----------------------- b --------------------------------
# which side to plot rownames: right = 2
axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0,
cex.axis = cexRow)
if (!is.null(ylab))
# remember to change this to 2 as well
mtext(ylab, side = 2, line = margins[2L] - 1.25)
if (!missing(add.expr))
eval.parent(substitute(add.expr))
# plot row dendro
par(mar = c(margins[1L], 0, 0, 0))
if (doRdend)
plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none")
else frame()
# plot col dendro
par(mar = c(0, 0, if (!is.null(main)) 1 else 0, margins[2L]))
if (doCdend)
plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none")
else if (!is.null(main))
frame()
# title
if (!is.null(main)) {
par(xpd = NA, mar = c(0, 0, 1, 0))
title(main, cex.main = 1.5 * op[["cex.main"]])
}
invisible(list(rowInd = rowInd, colInd = colInd,
Rowv = if (keep.dendro && doRdend) ddr,
Colv = if (keep.dendro && doCdend) ddc))
}
绘制热图：
heatmap(
vkm,
Rowv = NA,
Colv = NA,
cexRow = 1,
cexCol = 1,
margins = c(3, 5),
main = "Ionospheric Reflection Variance"
)
mtext("K-Means Cluster Size Analysis: 2-10", line = 0)
图中是这样的：
然而，这可以通过 ggplot2::geom_raster:
library(ggplot2)
df <- expand.grid(
vars = rownames(vkm),
cols = colnames(vkm)
)
df$value <- c(vkm)
ggplot(df, aes(x = cols, y = vars)) +
geom_raster(aes(fill = value)) +
scale_fill_gradient(low = 'red', high = 'yellow') +
ggtitle(bquote(
atop("Ionospheric Reflection Variance",
atop("K-Means Cluster Size Analysis: 2-10")))) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank()
)
结果是：