library(tidyverse)
library(ggpubr)
library(ggplotify)
library(corrplot)
library(pheatmap)
library(RColorBrewer)
rm(list = ls())
options(stringsAsFactors = F)
options(future.globals.maxSize = 10000 * 1024^2)
grp_names <- c("Early Stage", "Late Stage")
grp_colors <- c("#8AC786", "#B897CA")
grp_shapes <- c(15, 16)18 免疫浸润分析
在本章节中，将详细探讨免疫细胞的组成结构、其在不同个体和分组之间的相对丰度差异，并通过热图等可视化手段，对这些差异进行直观而深入的解析。这些分析将有助于科研人员更好地理解免疫细胞在生物体内的分布规律及其在不同条件下的变化特征。
18.1 加载R包
使用rm(list = ls())来清空环境中的所有变量。
18.2 导入数据
-
ImmueCell来自于 章节 17。
18.3 所需函数
get_plot获得数据分析可视化图；-
通过plotType参数选择不同的图形。
boxplot（箱线图）：一种用于显示一组数据分散情况资料的统计图。因形状如箱子而得名，又称为箱型图、盒须图或盒式图。箱线图通过绘制数据的中位数（Q2）、四分位数（Q1和Q3）、异常值（如有）等信息，可以直观地展示数据的分布特征。
violin（小提琴图）：小提琴图（Violin Plot）是一种用于显示数据分布及其概率密度的图表。这种图表结合了箱形图和密度图的特征，主要用来显示数据的分布形状。在小提琴图中，中间的黑色粗线条表示四分位数的范围，从其上延伸出来的细黑线表示数据的范围，两端为最大值和最小值，而白色点则为中位数。与箱形图相比，小提琴图除了能显示上述的统计数据外，还能更直观地展示数据的整体分布，尤其是在数据量非常大时，小提琴图特别适用。
stackedbar（堆积图）：堆积图（Stacked Chart）或堆积条形图（Stacked Bar Chart）、堆积柱状图（Stacked Column Chart）以及堆积面积图（Stacked Area Chart）等是数据可视化中常用的图表类型，它们通过堆叠不同类别的数据来展示数据之间的总量和构成关系
heatmap（热图）：热图是一种数据可视化工具，通过颜色的深浅来表示数据的值或密度。它可以直观地展示数据的分布和变化情况，帮助人们更好地理解数据。
corrplot（相关性矩阵图）：相关性矩阵图（Correlation Matrix Plot）是一种用于展示数据集中不同变量之间相关性的可视化工具。它通过矩阵的形式，将每对变量之间的相关性系数以数值或颜色的方式表示出来，从而可以直观地看出哪些变量之间存在较强的相关性，以及这些相关性的正负方向。
get_plot <- function(
object,
plabel = c("p.signif", "p.format"),
plotType = c("boxplot", "violin",
"stackedbar", "heatmap", "corrplot"),
group,
group_names = grp_names,
group_colors = grp_colors,
plotData = TRUE) {
colnames(object)[which(colnames(object) == group)] <- "GroupCompvar"
object <- object %>%
dplyr::arrange(GroupCompvar, Tumour_Stage)
object$GroupCompvar <- factor(object$GroupCompvar, levels = group_names)
phenotype <- object %>%
dplyr::select(1:8)
profile <- object %>%
dplyr::select(-c(2:8)) %>%
tibble::column_to_rownames("SampleID") %>%
dplyr::select(-all_of(c("Effector_memory", "Gamma_delta",
"Central_memory")))
dat <- profile[, colSums(profile) > 0]
if (!all(rownames(dat) == phenotype$SampleID)) {
message("wrong order between dat and phenotype")
} else {
dat <- dat[pmatch(rownames(dat), phenotype$SampleID), ]
}
lvls <- unique(phenotype$GroupCompvar)
dat$GroupCompvar <- phenotype$GroupCompvar
dat$GroupCompvar <- factor(dat$GroupCompvar, levels = lvls)
dat$SampleID <- rownames(dat)
if (plotType %in% c("boxplot", "violin", "stackedbar")) {
plotdata <- dat %>%
tidyr::gather(key = "CellType",
value = "Composition",
-c("SampleID", "GroupCompvar"))
plot_order <- plotdata[plotdata$GroupCompvar == lvls[1], ] %>%
dplyr::group_by(CellType) %>%
dplyr::summarise(md = median(Composition)) %>%
dplyr::arrange(desc(md)) %>%
dplyr::pull(CellType)
plotdata$CellType <- factor(plotdata$CellType,
levels = plot_order)
if (plotType == "boxplot") {
pl <- ggplot(plotdata, aes(x = CellType, y = Composition)) +
stat_boxplot(aes(color = GroupCompvar), position = position_dodge(0.5),
geom = "errorbar", width = 0.2) +
geom_boxplot(aes(fill = GroupCompvar),
position = position_dodge(0.5),
width = 0.5,
outlier.alpha = 0) +
stat_compare_means(aes(group = GroupCompvar),
label = plabel,
method = "wilcox.test",
hide.ns = F) +
scale_fill_manual(values = group_colors) +
scale_color_manual(values = group_colors) +
scale_y_continuous(expand = expansion(mult = c(0.05, 0.1))) +
labs(y = "Ratio", x = NULL) +
theme_bw() +
theme(plot.title = element_text(size = 12, color = "black", hjust = 0.5, face = "bold"),
axis.title = element_text(size = 11, color = "black", face = "bold"),
axis.text = element_text(size= 10, color = "black"),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1 ),
panel.grid = element_blank(),
legend.position = "top",
legend.text = element_text(size = 8),
legend.title= element_text(size = 10),
text = element_text(family = "serif"))
} else if (plotType == "stackedbar") {
plotdata$NewSampleID <- paste(plotdata$GroupCompvar, plotdata$SampleID, sep = "_")
mycolors <- colorRampPalette(brewer.pal(8, "Set1"))(length(unique(plotdata$CellType)))
pl <- ggplot(plotdata, aes(x = NewSampleID, y = Composition, fill = CellType)) +
geom_bar(stat = "identity", position = "fill") +
labs(y = "Immune Cells Relative Percentage", x = "") +
scale_y_continuous(expand = c(0, 0),
labels = scales::percent) +
scale_fill_manual(values = mycolors) +
guides(fill = guide_legend(title = NULL, ncol = 2)) +
annotate("text", x = as.numeric(table(object$GroupCompvar))[1]/2,
y = -0.03, label = group_names[1],
size = 3, color = "black") +
annotate("segment", x = 1, xend = as.numeric(table(object$GroupCompvar))[1],
y = -0.01, yend = -0.01,
color = group_colors[1], cex = 5) +
annotate("text", x = (dim(object)[1] - as.numeric(table(object$GroupCompvar))[1])/2 +
as.numeric(table(object$GroupCompvar))[1],
y = -0.03, label = group_names[2],
size = 3, color = "black") +
annotate("segment", x = as.numeric(table(object$GroupCompvar))[1] + 1,
xend = dim(object)[1],
y = -0.01, yend = -0.01,
color = group_colors[2], cex = 5) +
theme_classic() +
theme(axis.title = element_text(size = 11, color = "black", face = "bold"),
axis.text = element_text(size = 10, color = "black"),
axis.text.x.bottom = element_blank(),
axis.line.x.bottom = element_blank(),
axis.ticks.x.bottom = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid = element_blank(),
legend.position = "right",
legend.key.size = unit(0.45, "cm"),
legend.text = element_text(size = 8),
text = element_text(family = "serif"))
} else if (plotType == "violin") {
pl <- ggplot(plotdata, aes(x = CellType, y = Composition)) +
geom_violin(aes(fill = GroupCompvar), trim = FALSE,
position = position_dodge(0.5),
outlier.color = "transparent") +
stat_compare_means(aes(group = GroupCompvar),
label = plabel,
method = "wilcox.test",
hide.ns = F) +
scale_fill_manual(values = group_colors) +
labs(y = "Ratio", x = NULL) +
theme_bw() +
theme(plot.title = element_text(size = 12, color = "black", hjust = 0.5, face = "bold"),
axis.title = element_text(size = 11, color = "black", face = "bold"),
axis.text = element_text(size= 10, color = "black"),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1 ),
panel.grid=element_blank(),
legend.position = "top",
legend.text = element_text(size = 8),
legend.title= element_text(size = 10),
text = element_text(family = "serif"))
}
} else if (plotType == "heatmap") {
plotdata <- dat %>%
dplyr::arrange(GroupCompvar) %>%
dplyr::select(-all_of(c("GroupCompvar", "SampleID"))) %>%
t()
annotation_col <- data.frame(
GroupCompvar = dat$GroupCompvar,
row.names = dat$SampleID)
temp <- pheatmap::pheatmap(
plotdata,
cluster_cols = F,
# cutree_cols = 2,
angle_col = "90",
annotation_col = annotation_col,
show_colnames = F,
fontfamily = "serif")
pl <- as.ggplot(temp)
} else if (plotType == "corrplot") {
plotdata <- dat %>%
dplyr::select(-all_of(c("GroupCompvar", "SampleID"))) %>%
as.matrix()
fit <- Hmisc::rcorr(plotdata, type = "spearman")
dataR <- signif(fit$r, 2)
# grDevices::windowsFonts()
par(family = "serif")
pl <- corrplot::corrplot(
dataR,
method = "color",
col = colorRampPalette(c("blue", "white", "red"))(100),
order = "AOE",
addCoef.col = "grey50",
number.cex = .7,
number.font = 1.5,
tl.cex = 0.8,
tl.srt = 45,
tl.col = "black")
}
if (plotType == "corrplot") {
datfit <- fit
} else {
datfit <- NULL
}
if (plotData) {
res <- list(plot = pl,
plotdata = plotdata,
fit = datfit)
} else {
res <- pl
}
return(res)
}18.4 堆积图
堆积图的意义：
总量和构成：堆积图最直观的功能就是显示不同类别的数据如何组成总体。每个类别的数据块（或柱形、面积）堆叠在一起，形成总体数据的高度或面积。
各部分比例：通过堆叠的高度或面积，可以很容易地看出每个类别在总体中所占的比例。
类别间的对比：在堆积图中，可以方便地对比不同类别的数据大小，以及它们随时间的变化情况。
数据层次：堆积图可以显示数据的层次结构，特别是在数据有多个分类维度时。例如，在一个销售数据中，可以同时展示不同产品类别、不同销售渠道的销售额。
异常值检测：如果某个类别的数据块突然增大或减小，可能意味着该类别出现了异常或重大变化。
ImmueCell_42_stackedbar <- get_plot(
object = ImmueCell,
plotType = "stackedbar",
group = "Group",
plotData = TRUE)
ImmueCell_42_stackedbar$plot结果：从图中可以看到不同癌症分期的免疫细胞在样本间存在个体特异性。
18.5 箱线图
两组的箱线图的意义：
数据分布的差异：通过比较两组数据的箱子高度、位置和中位数，可以判断两组数据的分散程度、中心位置和对称性是否有显著差异。
异常值的比较：箱线图可以清晰地展示两组数据中异常值的数量和分布情况，从而了解两组数据在极端值方面的差异。
统计检验的基础：箱线图可以为进一步的统计检验（如Mann-Whitney U检验）提供直观依据，帮助研究者判断两组数据是否具有统计差异。
ImmueCell_boxplot <- get_plot(
object = ImmueCell,
plabel = "p.signif",
group = "Group",
plotType = "boxplot",
plotData = TRUE)
ImmueCell_boxplot$plot结果：从图中可以看到某些免疫细胞如Tfh，Th2等在Early分期显著富集，这说明不同分期下的HCC有着不一样的肿瘤微环境。
18.6 热图
热图的意义：
数据分布：热图通过颜色的变化来展示数据在不同区域的分布情况。颜色越深，表示该区域的数据值越大或密度越高；颜色越浅，则表示数据值越小或密度越低。这有助于人们快速识别数据中的热点和冷点。
趋势分析：通过观察热图中颜色的渐变，可以分析数据的趋势。
异常检测：热图中的异常值通常会以与其他区域明显不同的颜色呈现出来，从而便于人们快速发现数据中的异常情况。
比较分析：通过对比不同条件下的热图，可以对不同数据集进行比较分析。例如，在生物实验中，可以对比不同处理组之间的基因表达热图，以找出处理效果对基因表达的影响。
ImmueCell_heatmap <- get_plot(
object = ImmueCell,
plotType = "heatmap",
group = "Group",
plotData = TRUE)结果：从图中可以看到不同癌症分期的免疫细胞在样本间存在个体特异性。
18.7 相关性矩阵图
相关性矩阵图意义：
- 相关性分析：相关图可以直观地展示数据集中变量之间的相关性，从而帮助研究人员快速了解哪些变量之间可能存在关系，以及关系的强度和方向。
- 模式识别：通过相关图，研究人员可以识别数据中的隐藏模式，例如哪些变量组合在一起时相关性较强，或者哪些变量与多个其他变量都有较强的相关性。
- 假设检验：在统计假设检验中，相关图可以作为一个初步的工具来检查数据是否符合预期的相关性模式。
- 数据探索：在数据探索阶段，相关图可以帮助研究人员了解数据的整体结构和变量之间的关系，为后续的分析和建模提供基础。
ImmueCell_corrplot <- get_plot(
object = ImmueCell,
plotType = "corrplot",
group = "Group",
plotData = TRUE)结果：从图中可以看到不同免疫细胞存在强相关。
18.8 输出结果
if (!dir.exists("./data/result/Figure/")) {
dir.create("./data/result/Figure/", recursive = TRUE)
}
ggsave("./data/result/Figure/Fig4-A.pdf", ImmueCell_42_stackedbar$plot, width = 10, height = 6, dpi = 600)
ggsave("./data/result/Figure/Fig4-B.pdf", ImmueCell_boxplot$plot, width = 10, height = 6, dpi = 600)
ggsave("./data/result/Figure/Fig4-C.pdf", ImmueCell_heatmap$plot, width = 8, height = 6, dpi = 600)
pdf("./data/result/Figure/Fig4-D.pdf", width = 8, height = 6)
temp_list <- get_plot(
object = ImmueCell,
plotType = "corrplot",
group = "Group",
plotData = TRUE)
dev.off()18.9 总结
在本章节中，通过对比免疫细胞在不同癌症分期的表现，深入探究了不同癌症分期人群的肿瘤微环境差异。为了清晰展示这些差异，采用了多种可视化工具，包括堆积图、箱线图、热图以及相关矩阵图等，对收集到的数据进行了详细的分析和呈现。经过细致的研究，最终发现，某些特定的免疫细胞类型在不同癌症分期组中表现出了显著的差异，这些差异为理解癌症发展与免疫细胞活性之间的关系提供了重要线索。
系统信息
R version 4.3.3 (2024-02-29)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.2
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: Asia/Shanghai
tzcode source: internal
attached base packages:
[1] stats graphics grDevices datasets utils methods base
other attached packages:
[1] RColorBrewer_1.1-3 pheatmap_1.0.12 corrplot_0.92 ggplotify_0.1.2
[5] ggpubr_0.6.0 lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1
[9] dplyr_1.1.4 purrr_1.0.2 readr_2.1.5 tidyr_1.3.1
[13] tibble_3.2.1 ggplot2_3.5.1 tidyverse_2.0.0
loaded via a namespace (and not attached):
[1] yulab.utils_0.1.4 utf8_1.2.4 generics_0.1.3
[4] renv_1.0.0 rstatix_0.7.2 stringi_1.8.4
[7] hms_1.1.3 digest_0.6.35 magrittr_2.0.3
[10] evaluate_0.23 grid_4.3.3 timechange_0.3.0
[13] fastmap_1.1.1 jsonlite_1.8.8 backports_1.4.1
[16] BiocManager_1.30.23 fansi_1.0.6 scales_1.3.0
[19] abind_1.4-5 cli_3.6.2 rlang_1.1.3
[22] munsell_0.5.1 cachem_1.0.8 withr_3.0.0
[25] yaml_2.3.8 tools_4.3.3 tzdb_0.4.0
[28] memoise_2.0.1 ggsignif_0.6.4 colorspace_2.1-0
[31] broom_1.0.5 gridGraphics_0.5-1 vctrs_0.6.5
[34] R6_2.5.1 lifecycle_1.0.4 fs_1.6.4
[37] car_3.1-2 htmlwidgets_1.6.4 pkgconfig_2.0.3
[40] pillar_1.9.0 gtable_0.3.5 glue_1.7.0
[43] xfun_0.43 tidyselect_1.2.1 rstudioapi_0.16.0
[46] knitr_1.46 htmltools_0.5.8.1 rmarkdown_2.26
[49] carData_3.0-5 compiler_4.3.3