如何使用 ggplot2、reshape2 和 Hmisc 在 R 中制作三角形热图？
How to do a triangle heatmap in R using ggplot2, reshape2, and Hmisc?
我需要帮助使用 ggplot2、reshape2 和 Hmisc 在 R 中绘制三角形热图，因为我需要在绘图上显示 r 和 P 值。
我试过在很多地方插入 cordata[lower.tri(c),] 但没有用。我也尝试过使用不同的方法，但它们没有显示我需要的 p 值和 rho！我已尝试在此处和 google 上搜索 "Hmisc+triangle+heatmap"，但没有找到有效的方法。
这是从 excel sheet 导入的原始数据：
df
# A tibble: 8 x 7
Urine Glucose Soil LB Gluconate River Colon
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 3222500 377750000 7847250 410000000 3252500 3900000 29800000
2 3667500 187000000 3937500 612000000 5250000 4057500 11075000
3 8362500 196250000 6207500 491000000 2417500 2185000 9725000
4 75700000 513000000 2909750 1415000000 3990000 3405000 NA
5 4485000 141250000 7241000 658750000 3742500 3470000 6695000
6 1947500 235000000 3277500 528500000 7045000 1897500 25475000
7 4130000 202500000 111475 442750000 6142500 4590000 4590000
8 1957500 446250000 8250000 233250000 5832500 5320000 5320000
代码：
library(readxl)
data1 <- read_excel("./pca-mean-data.xlsx", sheet = 1)
df <- data1[c(2,3,4,5,6,7,8,9,10,11)]
library(ggplot2)
library(reshape2)
library(Hmisc)
library(stats)
library(RColorBrewer)
abbreviateSTR <- function(value, prefix){ # format string more concisely
lst = c()
for (item in value) {
if (is.nan(item) || is.na(item)) { # if item is NaN return empty string
lst <- c(lst, '')
next
}
item <- round(item, 2) # round to two digits
if (item == 0) { # if rounding results in 0 clarify
item = '<.01'
}
item <- as.character(item)
item <- sub("(^[0])+", "", item) # remove leading 0: 0.05 -> .05
item <- sub("(^-[0])+", "-", item) # remove leading -0: -0.05 -> -.05
lst <- c(lst, paste(prefix, item, sep = ""))
}
return(lst)
}
d <- df
cormatrix = rcorr(as.matrix(d), type='pearson')
cordata = melt(cormatrix$r)
cordata$labelr = abbreviateSTR(melt(cormatrix$r)$value, 'r')
cordata$labelP = abbreviateSTR(melt(cormatrix$P)$value, 'P')
cordata$label = paste(cordata$labelr, "\n",
cordata$labelP, sep = "")
hm.palette <- colorRampPalette(rev(brewer.pal(11, 'Spectral')), space='Lab')
txtsize <- par('din')[2] / 2
pdf(paste("heatmap-MEANDATA-pearson.pdf",sep=""))
ggplot(cordata, aes(x=Var1, y=Var2, fill=value)) + geom_tile() +
theme(axis.text.x = element_text(angle=90, hjust=TRUE)) +
xlab("") + ylab("") +
geom_text(label=cordata$label, size=txtsize) +
scale_fill_gradient(colours = hm.palette(100))
dev.off()
我附上了我的样图，我只需要切成两半！如果可以的话请帮忙，我真的很感激！
我确信有一种更动态的方法可以做到这一点，但我只是硬编码了你不想要的东西。
cordata %>%
arrange(Var1) %>%
mutate_at(vars(value, label), funs(
ifelse(row_number() > 1 & Var2 == "Urine" |
row_number() > 9 & Var2 == "Glucose"|
row_number() > 17 & Var2 == "Soil" |
row_number() > 25 & Var2 == "LB" |
row_number() > 33 & Var2 == "Gluconate" |
row_number() > 41 & Var2 == "River", NA, .))) %>%
ggplot(aes(x=Var1, y=Var2, fill=value)) +
geom_tile()+
theme(axis.text.x = element_text(angle=90, hjust=TRUE))+
xlab("") +
ylab("") +
geom_text(aes(label=label), size=txtsize)
出于某种原因，我无法在我的计算机上使用您的配色方案。我也会再考虑一下，看看能不能让它更有活力。
编辑:
我有另一个想法，而且效果更好。我会保留旧的以供参考。
cordata %>%
arrange(Var1) %>%
group_by(Var1) %>%
filter(row_number() >= which(Var1 == Var2)) %>%
ggplot(aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
theme(axis.text.x = element_text(angle=90, hjust=TRUE)) +
xlab("") +
ylab("") +
geom_text(aes(label=label), size=txtsize)
我这里说的是，我要将Var1 = Var2 位置以下的所有数据按组过滤掉。这实质上删除了地图的下半部分，而第一种方法仅将特定变量行更改为 NA。
这是一种使用一些 dplyr 函数来重塑和过滤数据的方法。制作相关矩阵后，我 melting df_cor$r 和 df_cor$P 并加入它们，使将这些数据框放在一起更简洁（也更安全），然后制作标签。
然后我给每一行一个 ID 对，它是 Var1 和 Var2 粘贴在一起的组合的排序版本。因为我对它进行了排序，所以 (Urine, Soil) 和 (Soil, Urine) 的行将具有相同的 ID，而不管哪个是 Var1 哪个是 Var2。然后，按此 ID 分组，我进行不同的观察，使用 ID 作为挑选重复项的唯一标准。下面是那个长条形数据的头部
library(tidyverse)
library(Hmisc)
library(reshape2)
# ... function & df definitions removed
df_cor <- rcorr(as.matrix(df), type = "pearson")
df_long <- inner_join(
melt(df_cor$r, value.name = "r"),
melt(df_cor$P, value.name = "p"),
by = c("Var1", "Var2")
) %>%
mutate(r_lab = abbreviateSTR(r, "r"), p_lab = abbreviateSTR(p, "P")) %>%
mutate(label = paste(r_lab, p_lab, sep = "\n")) %>%
rowwise() %>%
mutate(pair = sort(c(Var1, Var2)) %>% paste(collapse = ",")) %>%
group_by(pair) %>%
distinct(pair, .keep_all = T)
head(df_long)
#> # A tibble: 6 x 8
#> # Groups: pair [6]
#> Var1 Var2 r p r_lab p_lab label pair
#> <fct> <fct> <dbl> <dbl> <chr> <chr> <chr> <chr>
#> 1 Urine Urine 1 NA r1 "" "r1\n" 1,1
#> 2 Glucose Urine 0.627 0.0963 r.63 P.1 "r.63\nP.1" 1,2
#> 3 Soil Urine -0.288 0.489 r-.29 P.49 "r-.29\nP.49" 1,3
#> 4 LB Urine 0.936 0.000634 r.94 P<.01 "r.94\nP<.01" 1,4
#> 5 Gluconate Urine -0.239 0.569 r-.24 P.57 "r-.24\nP.57" 1,5
#> 6 River Urine -0.102 0.811 r-.1 P.81 "r-.1\nP.81" 1,6
然后绘图就很简单了。我用的是minimal theme所以不会显示matrix的上半部分是空白的，并且关闭了grid因为这里意义不大
ggplot(df_long, aes(x = Var1, y = Var2, fill = r)) +
geom_raster() +
geom_text(aes(label = label)) +
scale_fill_distiller(palette = "Spectral") +
theme_minimal() +
theme(panel.grid = element_blank())
由 reprex package (v0.2.0) 创建于 2018-08-05。
我需要帮助使用 ggplot2、reshape2 和 Hmisc 在 R 中绘制三角形热图，因为我需要在绘图上显示 r 和 P 值。
我试过在很多地方插入 cordata[lower.tri(c),] 但没有用。我也尝试过使用不同的方法，但它们没有显示我需要的 p 值和 rho！我已尝试在此处和 google 上搜索 "Hmisc+triangle+heatmap"，但没有找到有效的方法。
这是从 excel sheet 导入的原始数据： df
# A tibble: 8 x 7
Urine Glucose Soil LB Gluconate River Colon
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 3222500 377750000 7847250 410000000 3252500 3900000 29800000
2 3667500 187000000 3937500 612000000 5250000 4057500 11075000
3 8362500 196250000 6207500 491000000 2417500 2185000 9725000
4 75700000 513000000 2909750 1415000000 3990000 3405000 NA
5 4485000 141250000 7241000 658750000 3742500 3470000 6695000
6 1947500 235000000 3277500 528500000 7045000 1897500 25475000
7 4130000 202500000 111475 442750000 6142500 4590000 4590000
8 1957500 446250000 8250000 233250000 5832500 5320000 5320000
代码：
library(readxl)
data1 <- read_excel("./pca-mean-data.xlsx", sheet = 1)
df <- data1[c(2,3,4,5,6,7,8,9,10,11)]
library(ggplot2)
library(reshape2)
library(Hmisc)
library(stats)
library(RColorBrewer)
abbreviateSTR <- function(value, prefix){ # format string more concisely
lst = c()
for (item in value) {
if (is.nan(item) || is.na(item)) { # if item is NaN return empty string
lst <- c(lst, '')
next
}
item <- round(item, 2) # round to two digits
if (item == 0) { # if rounding results in 0 clarify
item = '<.01'
}
item <- as.character(item)
item <- sub("(^[0])+", "", item) # remove leading 0: 0.05 -> .05
item <- sub("(^-[0])+", "-", item) # remove leading -0: -0.05 -> -.05
lst <- c(lst, paste(prefix, item, sep = ""))
}
return(lst)
}
d <- df
cormatrix = rcorr(as.matrix(d), type='pearson')
cordata = melt(cormatrix$r)
cordata$labelr = abbreviateSTR(melt(cormatrix$r)$value, 'r')
cordata$labelP = abbreviateSTR(melt(cormatrix$P)$value, 'P')
cordata$label = paste(cordata$labelr, "\n",
cordata$labelP, sep = "")
hm.palette <- colorRampPalette(rev(brewer.pal(11, 'Spectral')), space='Lab')
txtsize <- par('din')[2] / 2
pdf(paste("heatmap-MEANDATA-pearson.pdf",sep=""))
ggplot(cordata, aes(x=Var1, y=Var2, fill=value)) + geom_tile() +
theme(axis.text.x = element_text(angle=90, hjust=TRUE)) +
xlab("") + ylab("") +
geom_text(label=cordata$label, size=txtsize) +
scale_fill_gradient(colours = hm.palette(100))
dev.off()
我附上了我的样图，我只需要切成两半！如果可以的话请帮忙，我真的很感激！
我确信有一种更动态的方法可以做到这一点，但我只是硬编码了你不想要的东西。
cordata %>%
arrange(Var1) %>%
mutate_at(vars(value, label), funs(
ifelse(row_number() > 1 & Var2 == "Urine" |
row_number() > 9 & Var2 == "Glucose"|
row_number() > 17 & Var2 == "Soil" |
row_number() > 25 & Var2 == "LB" |
row_number() > 33 & Var2 == "Gluconate" |
row_number() > 41 & Var2 == "River", NA, .))) %>%
ggplot(aes(x=Var1, y=Var2, fill=value)) +
geom_tile()+
theme(axis.text.x = element_text(angle=90, hjust=TRUE))+
xlab("") +
ylab("") +
geom_text(aes(label=label), size=txtsize)
出于某种原因，我无法在我的计算机上使用您的配色方案。我也会再考虑一下，看看能不能让它更有活力。
编辑:
我有另一个想法，而且效果更好。我会保留旧的以供参考。
cordata %>%
arrange(Var1) %>%
group_by(Var1) %>%
filter(row_number() >= which(Var1 == Var2)) %>%
ggplot(aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
theme(axis.text.x = element_text(angle=90, hjust=TRUE)) +
xlab("") +
ylab("") +
geom_text(aes(label=label), size=txtsize)
我这里说的是，我要将Var1 = Var2 位置以下的所有数据按组过滤掉。这实质上删除了地图的下半部分，而第一种方法仅将特定变量行更改为 NA。
这是一种使用一些 dplyr 函数来重塑和过滤数据的方法。制作相关矩阵后，我 melting df_cor$r 和 df_cor$P 并加入它们，使将这些数据框放在一起更简洁（也更安全），然后制作标签。
然后我给每一行一个 ID 对，它是 Var1 和 Var2 粘贴在一起的组合的排序版本。因为我对它进行了排序，所以 (Urine, Soil) 和 (Soil, Urine) 的行将具有相同的 ID，而不管哪个是 Var1 哪个是 Var2。然后，按此 ID 分组，我进行不同的观察，使用 ID 作为挑选重复项的唯一标准。下面是那个长条形数据的头部
library(tidyverse)
library(Hmisc)
library(reshape2)
# ... function & df definitions removed
df_cor <- rcorr(as.matrix(df), type = "pearson")
df_long <- inner_join(
melt(df_cor$r, value.name = "r"),
melt(df_cor$P, value.name = "p"),
by = c("Var1", "Var2")
) %>%
mutate(r_lab = abbreviateSTR(r, "r"), p_lab = abbreviateSTR(p, "P")) %>%
mutate(label = paste(r_lab, p_lab, sep = "\n")) %>%
rowwise() %>%
mutate(pair = sort(c(Var1, Var2)) %>% paste(collapse = ",")) %>%
group_by(pair) %>%
distinct(pair, .keep_all = T)
head(df_long)
#> # A tibble: 6 x 8
#> # Groups: pair [6]
#> Var1 Var2 r p r_lab p_lab label pair
#> <fct> <fct> <dbl> <dbl> <chr> <chr> <chr> <chr>
#> 1 Urine Urine 1 NA r1 "" "r1\n" 1,1
#> 2 Glucose Urine 0.627 0.0963 r.63 P.1 "r.63\nP.1" 1,2
#> 3 Soil Urine -0.288 0.489 r-.29 P.49 "r-.29\nP.49" 1,3
#> 4 LB Urine 0.936 0.000634 r.94 P<.01 "r.94\nP<.01" 1,4
#> 5 Gluconate Urine -0.239 0.569 r-.24 P.57 "r-.24\nP.57" 1,5
#> 6 River Urine -0.102 0.811 r-.1 P.81 "r-.1\nP.81" 1,6
然后绘图就很简单了。我用的是minimal theme所以不会显示matrix的上半部分是空白的，并且关闭了grid因为这里意义不大
ggplot(df_long, aes(x = Var1, y = Var2, fill = r)) +
geom_raster() +
geom_text(aes(label = label)) +
scale_fill_distiller(palette = "Spectral") +
theme_minimal() +
theme(panel.grid = element_blank())
由 reprex package (v0.2.0) 创建于 2018-08-05。