最近遇到如何在boxplot基础上展示两组数据的FoldChange的问题,最后通过结合热图的方式解决了该问题。
加载R包
library(dplyr)
library(tibble)
library(data.table)
library(ggpubr)
library(cowplot)
导入数据
phen <- read.csv("phenotype.csv")
dat <- read.table("data.txt", header = T, row.names = 1, sep = "\t")
处理数据
mdat <- inner_join(phen, dat %>% rownames_to_column("SampleID"), by = "SampleID")
mdat$Group <- factor(mdat$Group, levels = c("HC", "NHC"))
boxplot展示组间差异
p1 <- ggplot(mdat, aes(x=Group, y=Species_Number))+
geom_boxplot(width=.3, outlier.shape = NA)+
geom_dotplot(aes(fill=Group, color=Group), binaxis = "y",
stackdir = "center",
position="jitter",
dotsize = .7)+
scale_fill_manual(values = c("blue", "red"))+
scale_color_manual(values = c("blue", "red"))+
stat_compare_means(comparisons = list(levels(mdat$Group)),
method = "wilcox.test",
label = "p.signif")+
scale_y_continuous(breaks = seq(0, 80, 10),
limits = c(0, 90))+
labs(x="")+
guides(fill=F, color=F)+
theme_classic()+
theme(axis.title = element_text(size = 10, color = "black", face = "bold"),
axis.text.x = element_blank(),
axis.ticks = element_blank(),
text = element_text(size = 8, color = "black"),
strip.text = element_text(size = 9, color = "black", face = "bold"),
panel.grid = element_blank())
heatmap展示FoldChange值
mdat.cln <- tapply(X = mdat$Species_Number, mdat$Group, median)
pdat <- data.frame(Group="Name",
FC="FC",
value=as.numeric(signif(mdat.cln[1]/mdat.cln[2], 2)))
p2 <- ggplot(pdat, aes(x=Group, y=FC, fill=value))+
geom_tile()+
guides(fill=F)+
labs(x="")+
scale_fill_gradient(low="blue", high="red")+
scale_y_discrete(expand = c(0, 0))+
scale_x_discrete(expand = c(0, 0))+
geom_text(aes(label = signif(value, 2)), size=10)+
theme_classic()+
theme(axis.title.x = element_blank(),
panel.grid = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
合并两图
plot_grid(p1, p2, ncol=1, align = "hv", rel_heights = c(2, .5))
R information
sessionInfo()
R version 4.0.3 (2020-10-10)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 10.16
Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] cowplot_1.1.0 pheatmap_1.0.12 ggpubr_0.4.0 ggplot2_3.3.2 data.table_1.13.2 tibble_3.0.4 dplyr_1.0.2
loaded via a namespace (and not attached):
[1] Rcpp_1.0.5 lattice_0.20-41 tidyr_1.1.2 digest_0.6.27 R6_2.5.0 cellranger_1.1.0
[7] plyr_1.8.6 backports_1.2.0 evaluate_0.14 pillar_1.4.6 rlang_0.4.8 curl_4.3
[13] readxl_1.3.1 rstudioapi_0.12 car_3.0-10 vegan_2.5-6 Matrix_1.2-18 rmarkdown_2.5
[19] labeling_0.4.2 splines_4.0.3 stringr_1.4.0 foreign_0.8-80 munsell_0.5.0 broom_0.7.2
[25] compiler_4.0.3 xfun_0.19 pkgconfig_2.0.3 mgcv_1.8-33 htmltools_0.5.0 tidyselect_1.1.0
[31] rio_0.5.16 permute_0.9-5 crayon_1.3.4 withr_2.3.0 MASS_7.3-53 grid_4.0.3
[37] nlme_3.1-150 jsonlite_1.7.1 gtable_0.3.0 lifecycle_0.2.0 magrittr_1.5 scales_1.1.1
[43] zip_2.1.1 stringi_1.5.3 carData_3.0-4 farver_2.0.3 ggsignif_0.6.0 ellipsis_0.3.1
[49] generics_0.1.0 vctrs_0.3.4 openxlsx_4.2.3 RColorBrewer_1.1-2 tools_4.0.3 forcats_0.5.0
[55] glue_1.4.2 purrr_0.3.4 hms_0.5.3 abind_1.4-5 parallel_4.0.3 yaml_2.2.1
[61] colorspace_2.0-0 cluster_2.1.0 rstatix_0.6.0 knitr_1.30