我想绘制一个包含彩色注释条的热图。一些数据背景。
我简化了下面的示例数据。
我有患者 ID 和一个数值测量值 (value_mean)，我想以热图的形式针对每个患者的每个“emm_type”进行绘制。每个“emm_type”都属于一个“簇”和一个“模式”。所以我希望热图包含一个彩色面板，描绘这些变量与其各自的 emm_type 对齐。
这是我的数据样本
> dput(example)
structure(list(id = c("RF0475", "RF0504", "RF0475", "RF0504",
"RF0475", "RF0504", "RF0475", "RF0504", "RF0475", "RF0504", "RF0475",
"RF0475", "RF0504", "RF0504", "RF0475", "RF0504", "RF0475", "RF0475",
"RF0475", "RF0475", "RF0475", "RF0475", "RF0504", "RF0504", "RF0504",
"RF0504", "RF0504", "RF0504", "RF0475", "RF0504", "RF0475", "RF0475",
"RF0504", "RF0504", "RF0475", "RF0475", "RF0475", "RF0475", "RF0475",
"RF0504", "RF0504", "RF0504", "RF0504", "RF0504", "RF0475", "RF0475",
"RF0475", "RF0475", "RF0475", "RF0504", "RF0504", "RF0504", "RF0504",
"RF0504", "RF0475", "RF0475", "RF0475", "RF0475", "RF0504", "RF0504",
"RF0504", "RF0504", "RF0475", "RF0504", "RF0475", "RF0504", "RF0475",
"RF0504", "RF0475", "RF0504", "RF0475", "RF0504", "RF0475", "RF0504"
), cluster = c("a-c2", "a-c2", "a-c3", "a-c3", "a-c4", "a-c4",
"a-c5", "a-c5", "d1", "d1", "d2", "d2", "d2", "d2", "d3", "d3",
"d4", "d4", "d4", "d4", "d4", "d4", "d4", "d4", "d4", "d4", "d4",
"d4", "e1", "e1", "e2", "e2", "e2", "e2", "e3", "e3", "e3", "e3",
"e3", "e3", "e3", "e3", "e3", "e3", "e4", "e4", "e4", "e4", "e4",
"e4", "e4", "e4", "e4", "e4", "e6", "e6", "e6", "e6", "e6", "e6",
"e6", "e6", "m19", "m19", "m218", "m218", "m233", "m233", "m6",
"m6", "m74", "m74", "m95", "m95"), pattern = c("a-c", "a-c",
"a-c", "a-c", "a-c", "a-c", "a-c", "a-c", "d", "d/a-c", "d",
"e", "d", "e", "d", "d", "d", "d", "d", "d", "d", "d", "d", "d",
"d", "d", "d", "d", "e", "e", "e", "e", "e", "e", "e", "e", "e",
"e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e",
"e", "e", "e", "e", "e", "d", "e", "d", "e", "d", "e", "d", "a-c",
"a-c", "d/a-c", "d/a-c", "a-c", "a-c", "a-c", "a-c", "d", "d",
"d", "d"), value_mean = c(1.82898259773807, 2.74970378862732,
2.31836858483114, 1.76297558336274, 6.99379366342489, 2.15775104765085,
9.81401417902465, 5.94493622813449, 6.42938334280903, 4.93258400244736,
4.42293379133012, 35.7119300124525, 85.8843942732351, 6.11004188703959,
4.46626647704635, 5.06748534630747, 2.34493589810343, 3.67864160152857,
3.49413303648271, 4.54325723822265, 11.6241914407818, 6.52797483395025,
2.29277958694861, 7.80004526681732, 2.69910122940354, 3.51802243804242,
6.70909678383865, 4.99681912787639, 5.54367727879201, 9.26383310897086,
4.57249586682161, 4.47787503848692, 12.3177425173967, 15.4240417229311,
4.14187570530094, 32.2447795214283, 2.8171424279428, 3.62644580807153,
79.8173447817745, 2.86868514917333, 4.13675844930625, 2.89891922608397,
120, 5.07500759868863, 3.31961544500323, 9.76557528920087, 4.93060063573198,
4.65192299498109, 66.3579869162384, 2.22596680234449, 5.70995502095345,
4.26850758713846, 120, 25.6383266263976, 2.90543208425715, 8.40935809851042,
2.31807635931822, 8.49055234623605, 3.29831448162297, 3.65068984963035,
1.93567603146573, 2.49808722814557, 3.14095440681389, 2.08508075133288,
3.08360524948663, 1.74613534854807, 1.91624362373354, 3.797786602908,
3.06755845905157, 3.11530841942899, 2.06455239407449, 1.71396244231883,
5.7985222607316, 3.74822367820585), group = c("case", "control",
"case", "control", "case", "control", "case", "control", "case",
"control", "case", "case", "control", "control", "case", "control",
"case", "case", "case", "case", "case", "case", "control", "control",
"control", "control", "control", "control", "case", "control",
"case", "case", "control", "control", "case", "case", "case",
"case", "case", "control", "control", "control", "control", "control",
"case", "case", "case", "case", "case", "control", "control",
"control", "control", "control", "case", "case", "case", "case",
"control", "control", "control", "control", "case", "control",
"case", "control", "case", "control", "case", "control", "case",
"control", "case", "control"), emm_type = structure(c(1L, 1L,
2L, 3L, 4L, 5L, 6L, 6L, 7L, 8L, 9L, 11L, 9L, 11L, 12L, 12L, 13L,
15L, 17L, 19L, 21L, 23L, 13L, 15L, 17L, 19L, 21L, 23L, 24L, 24L,
25L, 27L, 26L, 28L, 29L, 31L, 33L, 35L, 37L, 29L, 31L, 33L, 35L,
37L, 38L, 40L, 42L, 44L, 46L, 38L, 40L, 42L, 44L, 46L, 47L, 49L,
51L, 53L, 47L, 49L, 51L, 53L, 54L, 54L, 55L, 55L, 56L, 56L, 57L,
57L, 58L, 58L, 59L, 59L), .Label = c("197", "1", "238.1", "12",
"39.4", "3.1", "36.2", "54.1", "71", "100", "104", "123", "33",
"41.2", "52", "53", "86", "91", "93.4", "101", "108.1", "116.1",
"225", "4", "68", "76", "90.5", "92", "25", "44", "49", "58",
"82", "87", "103", "113", "118", "2", "8", "22", "28", "77",
"88", "89", "114", "232.1", "11", "42", "59.1", "65", "75", "81",
"85", "19.4", "218.1", "233", "6", "74", "95"), class = "factor", scores = structure(c(`1` = 2,
`2` = 12, `3.1` = 4, `4` = 9, `6` = 17, `8` = 12, `11` = 13,
`12` = 3, `19.4` = 14, `22` = 12, `25` = 11, `28` = 12, `33` = 8,
`36.2` = 5, `39.4` = 3, `41.2` = 8, `42` = 13, `44` = 11, `49` = 11,
`52` = 8, `53` = 8, `54.1` = 5, `58` = 11, `59.1` = 13, `65` = 13,
`68` = 10, `71` = 6, `74` = 18, `75` = 13, `76` = 10, `77` = 12,
`81` = 13, `82` = 11, `85` = 13, `86` = 8, `87` = 11, `88` = 12,
`89` = 12, `90.5` = 10, `91` = 8, `92` = 10, `93.4` = 8, `95` = 19,
`100` = 6, `101` = 8, `103` = 11, `104` = 6, `108.1` = 8, `113` = 11,
`114` = 12, `116.1` = 8, `118` = 11, `123` = 7, `197` = 1, `218.1` = 15,
`225` = 8, `232.1` = 12, `233` = 16, `238.1` = 2), .Dim = 59L, .Dimnames = list(
c("1", "2", "3.1", "4", "6", "8", "11", "12", "19.4", "22",
"25", "28", "33", "36.2", "39.4", "41.2", "42", "44", "49",
"52", "53", "54.1", "58", "59.1", "65", "68", "71", "74",
"75", "76", "77", "81", "82", "85", "86", "87", "88", "89",
"90.5", "91", "92", "93.4", "95", "100", "101", "103", "104",
"108.1", "113", "114", "116.1", "118", "123", "197", "218.1",
"225", "232.1", "233", "238.1"))))), row.names = c(NA, -74L
), class = c("tbl_df", "tbl", "data.frame"))
我使用以下代码为案例和控件绘制了热图:
(cases_heatmap <- ggplot(filter(example, group == "case"), aes(id, factor(emm_type)))+geom_tile(aes(fill=value_mean), colour="white")+
scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 60,limits=c(0,max(example$value_mean)))+
scale_y_discrete(expand = c(0, 0)) +
theme(axis.ticks=element_blank(),
axis.text.x=element_text(angle = 90, vjust = 0.6),legend.position = "none")+
coord_equal())
(cases_heatmap <- ggplot(filter(example, group == "control"), aes(id, factor(emm_type)))+geom_tile(aes(fill=value_mean), colour="white")+
scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 60,limits=c(0,max(example$value_mean)))+
scale_y_discrete(expand = c(0, 0)) +
theme(axis.ticks=element_blank(),
axis.text.x=element_text(angle = 90, vjust = 0.6),legend.position = "none")+
coord_equal())
这给了我这样的东西(一个用于案例，一个用于控制:
为了沿着它绘制集群和模式，我稍微调整了数据以获得我可以绘制的列(使用“cluster_text”和“pattern_text”列)，以及有一个数字排序(num_cluster ):
example <- example%>%
mutate(num_cluster = as.numeric(factor(example$cluster))) %>%
mutate(num_pattern = as.numeric(factor(example$pattern))) %>%
mutate(cluster_text = "Cluster") %>%
mutate(pattern_text = "Pattern")
[1]: /image/CO1eP.jpg
因为我希望将集群组合在一起，所以我重新排序了级别:
example$emm_type <- reorder(example$emm_type, example$cluster)
然后为了获得带有颜色的注释条(集群和模式)，我想在热图旁边绘制这些颜色，我绘制了新创建的“cluster_text”和“pattern_text”列的另一个 geom_tile:
cluster_annotation <- ggplot(filter(example, group == "case"), aes(cluster_text, factor(emm_type)))+geom_tile(aes(fill=cluster), colour="white")+
coord_equal()+
theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank())
pattern_annotation <- ggplot(filter(example, group == "case"), aes(pattern_text, factor(emm_type)))+geom_tile(aes(fill=pattern), colour="white")+
coord_equal()+
theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank())
这给了我想要的注释图 block (这个用于集群，我得到了相同的模式):
现在我想要所有的瓷砖彼此相邻，甚至绘制在同一个 geom_tile 上，以便 emm_types 与它们各自的模式和集群对齐，但我无法弄清楚如何去做。
这是我最终图表的图片，当我使用更多数据时，我希望它们彼此相邻对齐:
> sessionInfo()
R version 3.5.0 (2018-04-23)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS High Sierra 10.13.6
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
locale:
[1] en_NZ.UTF-8/en_NZ.UTF-8/en_NZ.UTF-8/C/en_NZ.UTF-8/en_NZ.UTF-8
attached base packages:
[1] grid stats graphics grDevices utils datasets methods base
other attached packages:
[1] bindrcpp_0.2.2 cowplot_0.9.3 scales_0.5.0 forcats_0.3.0 stringr_1.3.1 dplyr_0.7.6 purrr_0.2.5 readr_1.1.1 tidyr_0.8.1 tibble_1.4.2
[11] ggplot2_3.0.0 tidyverse_1.2.1 readxl_1.1.0
loaded via a namespace (and not attached):
[1] Rcpp_0.12.18 cellranger_1.1.0 pillar_1.3.0 compiler_3.5.0 plyr_1.8.4 bindr_0.1.1 tools_3.5.0 digest_0.6.15 lubridate_1.7.4
[10] jsonlite_1.5 nlme_3.1-137 gtable_0.2.0 lattice_0.20-35 pkgconfig_2.0.1 rlang_0.2.1 cli_1.0.0 rstudioapi_0.7 yaml_2.2.0
[19] haven_1.1.2 withr_2.1.2 xml2_1.2.0 httr_1.3.1 hms_0.4.2 tidyselect_0.2.4 glue_1.3.0 R6_2.2.2 fansi_0.2.3
[28] reshape2_1.4.3 modelr_0.1.2 magrittr_1.5 backports_1.1.2 rvest_0.3.2 assertthat_0.2.0 colorspace_1.3-2 labeling_0.3 utf8_1.1.4
[37] stringi_1.2.4 lazyeval_0.2.1 munsell_0.5.0 broom_0.5.0 crayon_1.3.4
最佳答案
要在同一 geom_tile() 上绘制“Cluster”列和“Pattern”列，我们需要先将数据从宽改成长。
library(tidyr)
example %>%
gather(annotation, value, cluster, pattern) %>%
ggplot(., aes(annotation, factor(emm_type)))+geom_tile(aes(fill=value), colour="white")+
coord_equal()+
theme(axis.title.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(angle = 90, vjust = 0.6)) -> p_annotation
合并绘图。
library(patchwork)
cases_heatmap + controls_heatmap + p_annotation
先试试
有一些包*允许组合 ggplot 对象，其中之一是 patchwork .
# install.packages("devtools")
# devtools::install_github("thomasp85/patchwork")
library(patchwork)
cases_heatmap + controls_heatmap + cluster_annotation + pattern_annotation +
plot_layout(nrow = 1)
*其他包是egg , cowplot , multipanelfigure , ... .
关于r - 如何使用 ggplot2 将两个 geom_tile 彼此相邻绘制，以便它们像在热图中一样对齐？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/51780437/