R可视化：Boxplot+FoldChange展示

最近遇到如何在boxplot基础上展示两组数据的FoldChange的问题，最后通过结合热图的方式解决了该问题。更多知识分享请到 https://zouhua.top/。

加载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