Pheatmap 注释颜色和边框
Pheatmap annotation colors and border
Pheatmap library(pheatmap) 需要 annotation_colors 在每个热图列的顶部添加 header ID 颜色。
我想添加白色作为带边框的列 header 颜色。
border_color 可以添加边框，但此函数也会为整个热图绘制边框。
以下是我目前所做的。
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1],
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
我非常努力地编辑 grobs 以仅在注释上添加边框颜色，但我认为唯一的方法是修改 pheatmap 函数以及底层 heatmap_motor.这是 pheatmap2 和 heatmap_motor2 函数。唯一的变化是 pheatmap2 调用 heatmap_motor2 并且 heatmap_motor2 中的这一行 border_color="gray"。您可以在 heatmap_motor2.
中找到大约 2/3 的路径
pheatmap2
pheatmap2 <-function (mat, color = colorRampPalette(rev(brewer.pal(n = 7,
name = "RdYlBu")))(100), kmeans_k = NA, breaks = NA, border_color = "grey60",
cellwidth = NA, cellheight = NA, scale = "none", cluster_rows = TRUE,
cluster_cols = TRUE, clustering_distance_rows = "euclidean",
clustering_distance_cols = "euclidean", clustering_method = "complete",
clustering_callback = identity2, cutree_rows = NA, cutree_cols = NA,
treeheight_row = ifelse(cluster_rows, 50, 0), treeheight_col = ifelse(cluster_cols,
50, 0), legend = TRUE, legend_breaks = NA, legend_labels = NA,
annotation_row = NA, annotation_col = NA, annotation = NA,
annotation_colors = NA, annotation_legend = TRUE, drop_levels = TRUE,
show_rownames = T, show_colnames = T, main = NA, fontsize = 10,
fontsize_row = fontsize, fontsize_col = fontsize, display_numbers = F,
number_format = "%.2f", number_color = "grey30", fontsize_number = 0.8 *
fontsize, gaps_row = NULL, gaps_col = NULL, labels_row = NULL,
labels_col = NULL, filename = NA, width = NA, height = NA,
silent = FALSE, ...)
{
if (is.null(labels_row)) {
labels_row = rownames(mat)
}
if (is.null(labels_col)) {
labels_col = colnames(mat)
}
mat = as.matrix(mat)
if (scale != "none") {
mat = scale_mat(mat, scale)
if (is.na2(breaks)) {
breaks = generate_breaks(mat, length(color), center = T)
}
}
if (!is.na(kmeans_k)) {
km = kmeans(mat, kmeans_k, iter.max = 100)
mat = km$centers
t = table(km$cluster)
labels_row = sprintf("Cluster: %s Size: %d", names(t),
t)
}
else {
km = NA
}
if (is.matrix(display_numbers) | is.data.frame(display_numbers)) {
if (nrow(display_numbers) != nrow(mat) | ncol(display_numbers) !=
ncol(mat)) {
stop("If display_numbers provided as matrix, its dimensions have to match with mat")
}
display_numbers = as.matrix(display_numbers)
fmat = matrix(as.character(display_numbers), nrow = nrow(display_numbers),
ncol = ncol(display_numbers))
fmat_draw = TRUE
}
else {
if (display_numbers) {
fmat = matrix(sprintf(number_format, mat), nrow = nrow(mat),
ncol = ncol(mat))
fmat_draw = TRUE
}
else {
fmat = matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
fmat_draw = FALSE
}
}
if (cluster_rows) {
tree_row = cluster_mat(mat, distance = clustering_distance_rows,
method = clustering_method)
tree_row = clustering_callback(tree_row, mat)
mat = mat[tree_row$order, , drop = FALSE]
fmat = fmat[tree_row$order, , drop = FALSE]
labels_row = labels_row[tree_row$order]
if (!is.na(cutree_rows)) {
gaps_row = find_gaps(tree_row, cutree_rows)
}
else {
gaps_row = NULL
}
}
else {
tree_row = NA
treeheight_row = 0
}
if (cluster_cols) {
tree_col = cluster_mat(t(mat), distance = clustering_distance_cols,
method = clustering_method)
tree_col = clustering_callback(tree_col, t(mat))
mat = mat[, tree_col$order, drop = FALSE]
fmat = fmat[, tree_col$order, drop = FALSE]
labels_col = labels_col[tree_col$order]
if (!is.na(cutree_cols)) {
gaps_col = find_gaps(tree_col, cutree_cols)
}
else {
gaps_col = NULL
}
}
else {
tree_col = NA
treeheight_col = 0
}
attr(fmat, "draw") = fmat_draw
if (!is.na2(legend_breaks) & !is.na2(legend_labels)) {
if (length(legend_breaks) != length(legend_labels)) {
stop("Lengths of legend_breaks and legend_labels must be the same")
}
}
if (is.na2(breaks)) {
breaks = generate_breaks(as.vector(mat), length(color))
}
if (legend & is.na2(legend_breaks)) {
legend = grid.pretty(range(as.vector(breaks)))
names(legend) = legend
}
else if (legend & !is.na2(legend_breaks)) {
legend = legend_breaks[legend_breaks >= min(breaks) &
legend_breaks <= max(breaks)]
if (!is.na2(legend_labels)) {
legend_labels = legend_labels[legend_breaks >= min(breaks) &
legend_breaks <= max(breaks)]
names(legend) = legend_labels
}
else {
names(legend) = legend
}
}
else {
legend = NA
}
mat = scale_colours(mat, col = color, breaks = breaks)
if (is.na2(annotation_col) & !is.na2(annotation)) {
annotation_col = annotation
}
if (!is.na2(annotation_col)) {
annotation_col = annotation_col[colnames(mat), , drop = F]
}
if (!is.na2(annotation_row)) {
annotation_row = annotation_row[rownames(mat), , drop = F]
}
annotation = c(annotation_row, annotation_col)
annotation = annotation[unlist(lapply(annotation, function(x) !is.na2(x)))]
if (length(annotation) != 0) {
annotation_colors = generate_annotation_colours(annotation,
annotation_colors, drop = drop_levels)
}
else {
annotation_colors = NA
}
if (!show_rownames) {
labels_row = NULL
}
if (!show_colnames) {
labels_col = NULL
}
gt = heatmap_motor2(mat, border_color = border_color, cellwidth = cellwidth,
cellheight = cellheight, treeheight_col = treeheight_col,
treeheight_row = treeheight_row, tree_col = tree_col,
tree_row = tree_row, filename = filename, width = width,
height = height, breaks = breaks, color = color, legend = legend,
annotation_row = annotation_row, annotation_col = annotation_col,
annotation_colors = annotation_colors, annotation_legend = annotation_legend,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number,
number_color = number_color, gaps_row = gaps_row, gaps_col = gaps_col,
labels_row = labels_row, labels_col = labels_col, ...)
if (is.na(filename) & !silent) {
grid.newpage()
grid.draw(gt)
}
invisible(list(tree_row = tree_row, tree_col = tree_col,
kmeans = km, gtable = gt))
}
heatmap_motor2
heatmap_motor2 <-function (matrix, border_color, cellwidth, cellheight, tree_col,
tree_row, treeheight_col, treeheight_row, filename, width,
height, breaks, color, legend, annotation_row, annotation_col,
annotation_colors, annotation_legend, main, fontsize, fontsize_row,
fontsize_col, fmat, fontsize_number, number_color, gaps_col,
gaps_row, labels_row, labels_col, ...)
{
lo = lo(coln = labels_col, rown = labels_row, nrow = nrow(matrix),
ncol = ncol(matrix), cellwidth = cellwidth, cellheight = cellheight,
treeheight_col = treeheight_col, treeheight_row = treeheight_row,
legend = legend, annotation_col = annotation_col, annotation_row = annotation_row,
annotation_colors = annotation_colors, annotation_legend = annotation_legend,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, gaps_row = gaps_row, gaps_col = gaps_col,
...)
res = lo$gt
mindim = lo$mindim
if (!is.na(filename)) {
if (is.na(height)) {
height = convertHeight(gtable_height(res), "inches",
valueOnly = T)
}
if (is.na(width)) {
width = convertWidth(gtable_width(res), "inches",
valueOnly = T)
}
r = regexpr("\.[a-zA-Z]*$", filename)
if (r == -1)
stop("Improper filename")
ending = substr(filename, r + 1, r + attr(r, "match.length"))
f = switch(ending, pdf = function(x, ...) pdf(x, ...),
png = function(x, ...) png(x, units = "in", res = 300,
...), jpeg = function(x, ...) jpeg(x, units = "in",
res = 300, ...), jpg = function(x, ...) jpeg(x,
units = "in", res = 300, ...), tiff = function(x,
...) tiff(x, units = "in", res = 300, compression = "lzw",
...), bmp = function(x, ...) bmp(x, units = "in",
res = 300, ...), stop("File type should be: pdf, png, bmp, jpg, tiff"))
f(filename, height = height, width = width)
gt = heatmap_motor(matrix, cellwidth = cellwidth, cellheight = cellheight,
border_color = border_color, tree_col = tree_col,
tree_row = tree_row, treeheight_col = treeheight_col,
treeheight_row = treeheight_row, breaks = breaks,
color = color, legend = legend, annotation_col = annotation_col,
annotation_row = annotation_row, annotation_colors = annotation_colors,
annotation_legend = annotation_legend, filename = NA,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number,
number_color = number_color, labels_row = labels_row,
labels_col = labels_col, gaps_col = gaps_col, gaps_row = gaps_row,
...)
grid.draw(gt)
dev.off()
return(gt)
}
if (mindim < 3)
border_color = NA
if (!is.na(main)) {
elem = draw_main(main, fontsize = 1.3 * fontsize, ...)
res = gtable_add_grob(res, elem, t = 1, l = 3, name = "main")
}
if (!is.na2(tree_col) & treeheight_col != 0) {
elem = draw_dendrogram(tree_col, gaps_col, horizontal = T)
res = gtable_add_grob(res, elem, t = 2, l = 3, name = "col_tree")
}
if (!is.na2(tree_row) & treeheight_row != 0) {
elem = draw_dendrogram(tree_row, gaps_row, horizontal = F)
res = gtable_add_grob(res, elem, t = 4, l = 1, name = "row_tree")
}
elem = draw_matrix(matrix, border_color, gaps_row, gaps_col,
fmat, fontsize_number, number_color)
res = gtable_add_grob(res, elem, t = 4, l = 3, clip = "off",
name = "matrix")
if (length(labels_col) != 0) {
pars = list(labels_col, gaps = gaps_col, fontsize = fontsize_col,
...)
elem = do.call(draw_colnames, pars)
res = gtable_add_grob(res, elem, t = 5, l = 3, clip = "off",
name = "col_names")
}
if (length(labels_row) != 0) {
pars = list(labels_row, gaps = gaps_row, fontsize = fontsize_row,
...)
elem = do.call(draw_rownames, pars)
res = gtable_add_grob(res, elem, t = 4, l = 4, clip = "off",
name = "row_names")
}
if (!is.na2(annotation_col)) {
converted_annotation = convert_annotations(annotation_col,
annotation_colors)
elem = draw_annotations(converted_annotation, border_color="gray", #Modified here
gaps_col, fontsize, horizontal = T)
res = gtable_add_grob(res, elem, t = 3, l = 3, clip = "off",
name = "col_annotation")
elem = draw_annotation_names(annotation_col, fontsize,
horizontal = T)
res = gtable_add_grob(res, elem, t = 3, l = 4, clip = "off",
name = "row_annotation_names")
}
if (!is.na2(annotation_row)) {
converted_annotation = convert_annotations(annotation_row,
annotation_colors)
elem = draw_annotations(converted_annotation, border_color,
gaps_row, fontsize, horizontal = F)
res = gtable_add_grob(res, elem, t = 4, l = 2, clip = "off",
name = "row_annotation")
if (length(labels_col) != 0) {
elem = draw_annotation_names(annotation_row, fontsize,
horizontal = F)
res = gtable_add_grob(res, elem, t = 5, l = 2, clip = "off",
name = "row_annotation_names")
}
}
annotation = c(annotation_col[length(annotation_col):1],
annotation_row[length(annotation_row):1])
annotation = annotation[unlist(lapply(annotation, function(x) !is.na2(x)))]
if (length(annotation) > 0 & annotation_legend) {
elem = draw_annotation_legend(annotation, annotation_colors,
border_color, fontsize = fontsize, ...)
t = ifelse(is.null(labels_row), 4, 3)
res = gtable_add_grob(res, elem, t = t, l = 6, b = 5,
clip = "off", name = "annotation_legend")
}
if (!is.na2(legend)) {
elem = draw_legend(color, breaks, legend, fontsize = fontsize,
...)
t = ifelse(is.null(labels_row), 4, 3)
res = gtable_add_grob(res, elem, t = t, l = 5, b = 5,
clip = "off", name = "legend")
}
return(res)
}
那么重要的是将这两个新功能添加到 pheatmap 环境中。 pheatmap 使用只能在其自身环境中找到的功能。
environment(pheatmap2) <- asNamespace('pheatmap')
environment(heatmap_motor2) <- asNamespace('pheatmap')
注释的灰色边框使用 pheatmap2:
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap2(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1], #aka3[1]
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
我使用grid函数来编辑相关的grob：
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1],
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
# Edit the relevant grob
library(grid)
grid.ls(grid.force()) # "col_annotation" looks like it's the one to edit
grid.gedit("col_annotation", gp = gpar(col="grey70"))
将 grid.gget("col_annotation")$gp 应用于原始热图显示 col_annotation 确实有一个 gp 槽，其中设置了 fill 但没有 col。编辑后，fill和col都设置好了。
Pheatmap annotation_col/annotation_row 和边框以及 annotation_colors
只是想发表一些评论，这些评论可能有点偏离主题，但与这个问题的上下文相关，可能会为某人省去一些麻烦。
如果您有兴趣在设置 annotation_col 或 annotation_row 后为热图中的所有单元格添加边框，您必须明确指定高于特定级别的单元格高度和单元格宽度（我使用单元格宽度= 3, 单元格高度=12).
annotation_color 的语法有些复杂，需要具有命名组件的命名向量列表。例如：
annotation_col = data.frame("Cell_of_Origin"=factor(dta.disc$cell.origin,exclude=NULL,labels=c("GCB","non_GCB","Unclassifiable")))
rownames(annotation_col)=dta.disc$id
annotation_colors = list(Cell_of_Origin=c(GCB="red",non_GCB="green",Unclassifiable="yellow"))[1]
其中 Cell_of_Origin 是我的 annotation_col 变量和 GCB，non_GCB，不可分类是因子的水平。
我觉得为带注释的 类 添加网格而不是为集群添加网格（即子 类 可能分布在 'weirdly' 内簇）。我使用的一个选项是分别为每个子类生成树状图，然后将树状图合并在一起。在这种情况下，您可以使用 cutree_cols / cutree_row options.The 在集群之间添加间隙，结果不是很好，但这可能是一个探索的方向。
dend_gcb = reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[dta.disc$cell.origin=="gcb",vars_reduced]))))),agglo.FUN=mean)
dend_ngcb = reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[dta.disc$cell.origin=="non-gcb",vars_reduced]))))),agglo.FUN=mean)
dend_uncls =reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[is.na(dta.disc$cell.origin),vars_reduced]))))),agglo.FUN=mean)
dend=merge(merge(dend_gcb,dend_ngcb),dend_uncls)
Pheatmap library(pheatmap) 需要 annotation_colors 在每个热图列的顶部添加 header ID 颜色。
我想添加白色作为带边框的列 header 颜色。
border_color 可以添加边框，但此函数也会为整个热图绘制边框。
以下是我目前所做的。
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1],
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
我非常努力地编辑 grobs 以仅在注释上添加边框颜色，但我认为唯一的方法是修改 pheatmap 函数以及底层 heatmap_motor.这是 pheatmap2 和 heatmap_motor2 函数。唯一的变化是 pheatmap2 调用 heatmap_motor2 并且 heatmap_motor2 中的这一行 border_color="gray"。您可以在 heatmap_motor2.
pheatmap2
pheatmap2 <-function (mat, color = colorRampPalette(rev(brewer.pal(n = 7,
name = "RdYlBu")))(100), kmeans_k = NA, breaks = NA, border_color = "grey60",
cellwidth = NA, cellheight = NA, scale = "none", cluster_rows = TRUE,
cluster_cols = TRUE, clustering_distance_rows = "euclidean",
clustering_distance_cols = "euclidean", clustering_method = "complete",
clustering_callback = identity2, cutree_rows = NA, cutree_cols = NA,
treeheight_row = ifelse(cluster_rows, 50, 0), treeheight_col = ifelse(cluster_cols,
50, 0), legend = TRUE, legend_breaks = NA, legend_labels = NA,
annotation_row = NA, annotation_col = NA, annotation = NA,
annotation_colors = NA, annotation_legend = TRUE, drop_levels = TRUE,
show_rownames = T, show_colnames = T, main = NA, fontsize = 10,
fontsize_row = fontsize, fontsize_col = fontsize, display_numbers = F,
number_format = "%.2f", number_color = "grey30", fontsize_number = 0.8 *
fontsize, gaps_row = NULL, gaps_col = NULL, labels_row = NULL,
labels_col = NULL, filename = NA, width = NA, height = NA,
silent = FALSE, ...)
{
if (is.null(labels_row)) {
labels_row = rownames(mat)
}
if (is.null(labels_col)) {
labels_col = colnames(mat)
}
mat = as.matrix(mat)
if (scale != "none") {
mat = scale_mat(mat, scale)
if (is.na2(breaks)) {
breaks = generate_breaks(mat, length(color), center = T)
}
}
if (!is.na(kmeans_k)) {
km = kmeans(mat, kmeans_k, iter.max = 100)
mat = km$centers
t = table(km$cluster)
labels_row = sprintf("Cluster: %s Size: %d", names(t),
t)
}
else {
km = NA
}
if (is.matrix(display_numbers) | is.data.frame(display_numbers)) {
if (nrow(display_numbers) != nrow(mat) | ncol(display_numbers) !=
ncol(mat)) {
stop("If display_numbers provided as matrix, its dimensions have to match with mat")
}
display_numbers = as.matrix(display_numbers)
fmat = matrix(as.character(display_numbers), nrow = nrow(display_numbers),
ncol = ncol(display_numbers))
fmat_draw = TRUE
}
else {
if (display_numbers) {
fmat = matrix(sprintf(number_format, mat), nrow = nrow(mat),
ncol = ncol(mat))
fmat_draw = TRUE
}
else {
fmat = matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
fmat_draw = FALSE
}
}
if (cluster_rows) {
tree_row = cluster_mat(mat, distance = clustering_distance_rows,
method = clustering_method)
tree_row = clustering_callback(tree_row, mat)
mat = mat[tree_row$order, , drop = FALSE]
fmat = fmat[tree_row$order, , drop = FALSE]
labels_row = labels_row[tree_row$order]
if (!is.na(cutree_rows)) {
gaps_row = find_gaps(tree_row, cutree_rows)
}
else {
gaps_row = NULL
}
}
else {
tree_row = NA
treeheight_row = 0
}
if (cluster_cols) {
tree_col = cluster_mat(t(mat), distance = clustering_distance_cols,
method = clustering_method)
tree_col = clustering_callback(tree_col, t(mat))
mat = mat[, tree_col$order, drop = FALSE]
fmat = fmat[, tree_col$order, drop = FALSE]
labels_col = labels_col[tree_col$order]
if (!is.na(cutree_cols)) {
gaps_col = find_gaps(tree_col, cutree_cols)
}
else {
gaps_col = NULL
}
}
else {
tree_col = NA
treeheight_col = 0
}
attr(fmat, "draw") = fmat_draw
if (!is.na2(legend_breaks) & !is.na2(legend_labels)) {
if (length(legend_breaks) != length(legend_labels)) {
stop("Lengths of legend_breaks and legend_labels must be the same")
}
}
if (is.na2(breaks)) {
breaks = generate_breaks(as.vector(mat), length(color))
}
if (legend & is.na2(legend_breaks)) {
legend = grid.pretty(range(as.vector(breaks)))
names(legend) = legend
}
else if (legend & !is.na2(legend_breaks)) {
legend = legend_breaks[legend_breaks >= min(breaks) &
legend_breaks <= max(breaks)]
if (!is.na2(legend_labels)) {
legend_labels = legend_labels[legend_breaks >= min(breaks) &
legend_breaks <= max(breaks)]
names(legend) = legend_labels
}
else {
names(legend) = legend
}
}
else {
legend = NA
}
mat = scale_colours(mat, col = color, breaks = breaks)
if (is.na2(annotation_col) & !is.na2(annotation)) {
annotation_col = annotation
}
if (!is.na2(annotation_col)) {
annotation_col = annotation_col[colnames(mat), , drop = F]
}
if (!is.na2(annotation_row)) {
annotation_row = annotation_row[rownames(mat), , drop = F]
}
annotation = c(annotation_row, annotation_col)
annotation = annotation[unlist(lapply(annotation, function(x) !is.na2(x)))]
if (length(annotation) != 0) {
annotation_colors = generate_annotation_colours(annotation,
annotation_colors, drop = drop_levels)
}
else {
annotation_colors = NA
}
if (!show_rownames) {
labels_row = NULL
}
if (!show_colnames) {
labels_col = NULL
}
gt = heatmap_motor2(mat, border_color = border_color, cellwidth = cellwidth,
cellheight = cellheight, treeheight_col = treeheight_col,
treeheight_row = treeheight_row, tree_col = tree_col,
tree_row = tree_row, filename = filename, width = width,
height = height, breaks = breaks, color = color, legend = legend,
annotation_row = annotation_row, annotation_col = annotation_col,
annotation_colors = annotation_colors, annotation_legend = annotation_legend,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number,
number_color = number_color, gaps_row = gaps_row, gaps_col = gaps_col,
labels_row = labels_row, labels_col = labels_col, ...)
if (is.na(filename) & !silent) {
grid.newpage()
grid.draw(gt)
}
invisible(list(tree_row = tree_row, tree_col = tree_col,
kmeans = km, gtable = gt))
}
heatmap_motor2
heatmap_motor2 <-function (matrix, border_color, cellwidth, cellheight, tree_col,
tree_row, treeheight_col, treeheight_row, filename, width,
height, breaks, color, legend, annotation_row, annotation_col,
annotation_colors, annotation_legend, main, fontsize, fontsize_row,
fontsize_col, fmat, fontsize_number, number_color, gaps_col,
gaps_row, labels_row, labels_col, ...)
{
lo = lo(coln = labels_col, rown = labels_row, nrow = nrow(matrix),
ncol = ncol(matrix), cellwidth = cellwidth, cellheight = cellheight,
treeheight_col = treeheight_col, treeheight_row = treeheight_row,
legend = legend, annotation_col = annotation_col, annotation_row = annotation_row,
annotation_colors = annotation_colors, annotation_legend = annotation_legend,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, gaps_row = gaps_row, gaps_col = gaps_col,
...)
res = lo$gt
mindim = lo$mindim
if (!is.na(filename)) {
if (is.na(height)) {
height = convertHeight(gtable_height(res), "inches",
valueOnly = T)
}
if (is.na(width)) {
width = convertWidth(gtable_width(res), "inches",
valueOnly = T)
}
r = regexpr("\.[a-zA-Z]*$", filename)
if (r == -1)
stop("Improper filename")
ending = substr(filename, r + 1, r + attr(r, "match.length"))
f = switch(ending, pdf = function(x, ...) pdf(x, ...),
png = function(x, ...) png(x, units = "in", res = 300,
...), jpeg = function(x, ...) jpeg(x, units = "in",
res = 300, ...), jpg = function(x, ...) jpeg(x,
units = "in", res = 300, ...), tiff = function(x,
...) tiff(x, units = "in", res = 300, compression = "lzw",
...), bmp = function(x, ...) bmp(x, units = "in",
res = 300, ...), stop("File type should be: pdf, png, bmp, jpg, tiff"))
f(filename, height = height, width = width)
gt = heatmap_motor(matrix, cellwidth = cellwidth, cellheight = cellheight,
border_color = border_color, tree_col = tree_col,
tree_row = tree_row, treeheight_col = treeheight_col,
treeheight_row = treeheight_row, breaks = breaks,
color = color, legend = legend, annotation_col = annotation_col,
annotation_row = annotation_row, annotation_colors = annotation_colors,
annotation_legend = annotation_legend, filename = NA,
main = main, fontsize = fontsize, fontsize_row = fontsize_row,
fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number,
number_color = number_color, labels_row = labels_row,
labels_col = labels_col, gaps_col = gaps_col, gaps_row = gaps_row,
...)
grid.draw(gt)
dev.off()
return(gt)
}
if (mindim < 3)
border_color = NA
if (!is.na(main)) {
elem = draw_main(main, fontsize = 1.3 * fontsize, ...)
res = gtable_add_grob(res, elem, t = 1, l = 3, name = "main")
}
if (!is.na2(tree_col) & treeheight_col != 0) {
elem = draw_dendrogram(tree_col, gaps_col, horizontal = T)
res = gtable_add_grob(res, elem, t = 2, l = 3, name = "col_tree")
}
if (!is.na2(tree_row) & treeheight_row != 0) {
elem = draw_dendrogram(tree_row, gaps_row, horizontal = F)
res = gtable_add_grob(res, elem, t = 4, l = 1, name = "row_tree")
}
elem = draw_matrix(matrix, border_color, gaps_row, gaps_col,
fmat, fontsize_number, number_color)
res = gtable_add_grob(res, elem, t = 4, l = 3, clip = "off",
name = "matrix")
if (length(labels_col) != 0) {
pars = list(labels_col, gaps = gaps_col, fontsize = fontsize_col,
...)
elem = do.call(draw_colnames, pars)
res = gtable_add_grob(res, elem, t = 5, l = 3, clip = "off",
name = "col_names")
}
if (length(labels_row) != 0) {
pars = list(labels_row, gaps = gaps_row, fontsize = fontsize_row,
...)
elem = do.call(draw_rownames, pars)
res = gtable_add_grob(res, elem, t = 4, l = 4, clip = "off",
name = "row_names")
}
if (!is.na2(annotation_col)) {
converted_annotation = convert_annotations(annotation_col,
annotation_colors)
elem = draw_annotations(converted_annotation, border_color="gray", #Modified here
gaps_col, fontsize, horizontal = T)
res = gtable_add_grob(res, elem, t = 3, l = 3, clip = "off",
name = "col_annotation")
elem = draw_annotation_names(annotation_col, fontsize,
horizontal = T)
res = gtable_add_grob(res, elem, t = 3, l = 4, clip = "off",
name = "row_annotation_names")
}
if (!is.na2(annotation_row)) {
converted_annotation = convert_annotations(annotation_row,
annotation_colors)
elem = draw_annotations(converted_annotation, border_color,
gaps_row, fontsize, horizontal = F)
res = gtable_add_grob(res, elem, t = 4, l = 2, clip = "off",
name = "row_annotation")
if (length(labels_col) != 0) {
elem = draw_annotation_names(annotation_row, fontsize,
horizontal = F)
res = gtable_add_grob(res, elem, t = 5, l = 2, clip = "off",
name = "row_annotation_names")
}
}
annotation = c(annotation_col[length(annotation_col):1],
annotation_row[length(annotation_row):1])
annotation = annotation[unlist(lapply(annotation, function(x) !is.na2(x)))]
if (length(annotation) > 0 & annotation_legend) {
elem = draw_annotation_legend(annotation, annotation_colors,
border_color, fontsize = fontsize, ...)
t = ifelse(is.null(labels_row), 4, 3)
res = gtable_add_grob(res, elem, t = t, l = 6, b = 5,
clip = "off", name = "annotation_legend")
}
if (!is.na2(legend)) {
elem = draw_legend(color, breaks, legend, fontsize = fontsize,
...)
t = ifelse(is.null(labels_row), 4, 3)
res = gtable_add_grob(res, elem, t = t, l = 5, b = 5,
clip = "off", name = "legend")
}
return(res)
}
那么重要的是将这两个新功能添加到 pheatmap 环境中。 pheatmap 使用只能在其自身环境中找到的功能。
environment(pheatmap2) <- asNamespace('pheatmap')
environment(heatmap_motor2) <- asNamespace('pheatmap')
注释的灰色边框使用 pheatmap2:
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap2(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1], #aka3[1]
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
我使用grid函数来编辑相关的grob：
library(pheatmap)
set.seed(123)
df<-data.frame( matrix(sample(30), ncol = 5))
colnames(df)<-LETTERS[1:5]
subj<-c("P1", "P2","P3", "T1", "T2","T3")
rownames(df)<-subj
aka2 = data.frame(ID = factor(rep(c("Pat","Trea"), each=3)))
rownames(aka2)<-subj
aka3 = list(ID = c(Pat = "white", Trea="blue"))
pheatmap(t(scale(df)),
annotation_col = aka2,
annotation_colors = aka3[1],
annotation_legend = FALSE,
gaps_col = 3,
show_colnames = T, show_rownames = T, cluster_rows = F,
cluster_cols = F, legend = TRUE,
clustering_distance_rows = "euclidean", border_color = FALSE)
# Edit the relevant grob
library(grid)
grid.ls(grid.force()) # "col_annotation" looks like it's the one to edit
grid.gedit("col_annotation", gp = gpar(col="grey70"))
将 grid.gget("col_annotation")$gp 应用于原始热图显示 col_annotation 确实有一个 gp 槽，其中设置了 fill 但没有 col。编辑后，fill和col都设置好了。
Pheatmap annotation_col/annotation_row 和边框以及 annotation_colors
只是想发表一些评论，这些评论可能有点偏离主题，但与这个问题的上下文相关，可能会为某人省去一些麻烦。
如果您有兴趣在设置 annotation_col 或 annotation_row 后为热图中的所有单元格添加边框，您必须明确指定高于特定级别的单元格高度和单元格宽度（我使用单元格宽度= 3, 单元格高度=12).
annotation_color 的语法有些复杂，需要具有命名组件的命名向量列表。例如：
annotation_col = data.frame("Cell_of_Origin"=factor(dta.disc$cell.origin,exclude=NULL,labels=c("GCB","non_GCB","Unclassifiable"))) rownames(annotation_col)=dta.disc$id annotation_colors = list(Cell_of_Origin=c(GCB="red",non_GCB="green",Unclassifiable="yellow"))[1]
其中 Cell_of_Origin 是我的 annotation_col 变量和 GCB，non_GCB，不可分类是因子的水平。
我觉得为带注释的 类 添加网格而不是为集群添加网格（即子 类 可能分布在 'weirdly' 内簇）。我使用的一个选项是分别为每个子类生成树状图，然后将树状图合并在一起。在这种情况下，您可以使用 cutree_cols / cutree_row options.The 在集群之间添加间隙，结果不是很好，但这可能是一个探索的方向。
dend_gcb = reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[dta.disc$cell.origin=="gcb",vars_reduced]))))),agglo.FUN=mean) dend_ngcb = reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[dta.disc$cell.origin=="non-gcb",vars_reduced]))))),agglo.FUN=mean) dend_uncls =reorder(as.dendrogram(hclust(dist(as.matrix(t(dta.disc[is.na(dta.disc$cell.origin),vars_reduced]))))),agglo.FUN=mean) dend=merge(merge(dend_gcb,dend_ngcb),dend_uncls)