张泽民老师这篇Cancer cell好看的生信绘图代码

#---------Figure5-------## 该代码用于复现Figure5的两个核心子图（I和J），聚焦ADAM12敲除（KO）对不同肿瘤模型中癌症相关成纤维细胞（CAF）的影响# Library loading# 加载数据处理、可视化、单细胞分析所需的核心R包library(tidyr)       # 数据整理library(data.table)  # 高效数据处理library(dplyr)       # 数据筛选与转换library(tidyverse)   # 数据科学工具集library(reshape2)    # 数据重塑library(ggplot2)     # 基础可视化library(Seurat)      # 单细胞数据分析核心包library(ggsci)       # 科研配色方案library(RColorBrewer)# 配色生成library(pheatmap)    # 热图绘制library(AUCell)      # 基因集活性评分######## Figure I：ProgB/ProgC特征基因在不同模型中的表达变化热图# 1. 读取数据：包含B16、KPC、MC38三种肿瘤模型的CAF单细胞对象，以及ProgB/ProgC特征基因列表obj<-readRDS("fibro_cell_B16_KPC_MC38.rds")  # 整合后的CAF单细胞数据selected_genes<-read.csv("ProgB_ProgC_genes.csv")  # 关键特征基因（ProgB：抗瘤IFN-I响应程序；ProgC：促瘤肌成纤维细胞程序）# 2. 计算基因平均表达量：按“模型_处理组”（如B16_KO、B16_Ctrl）分组，提取目标基因的平均表达Idents(obj)<-'condition_model'  # 设置分组标识为“模型_处理组”avg_exp <- AverageExpression(obj,assays = "RNA",features = selected_genes,group.by = "condition_model")$RNA  # 计算平均表达dat <- as.matrix(avg_exp)  # 转换为矩阵格式# 3. 计算KO组相对于Ctrl组的表达倍数变化（log2转化）models <- unique(gsub("(.*)_.*", "\\1", colnames(dat)))  # 提取唯一模型名称（B16、KPC、MC38）ratio_matrix <- sapply(models, function(model){  ko_col <- paste0(model, "_KO")  # KO组列名  ctrl_col <- paste0(model, "_Ctrl")  # Ctrl组列名  if(!all(c(ko_col, ctrl_col) %in% colnames(dat))){    message(paste("缺少", model, "的配对数据"))  # 缺失数据提示    return(rep(NA, nrow(dat)))  }  log2( (dat[, ko_col]) / (dat[, ctrl_col]) )  # 计算log2(KO/Ctrl)，反映表达变化趋势})# 4. 热图可视化：展示三种模型中特征基因的表达变化rownames(ratio_matrix) <- rownames(dat)  # 保留基因名作为行名ratio_matrix <- na.omit(ratio_matrix)  # 去除缺失值norm_data<-t(ratio_matrix )  # 转置矩阵（行：模型，列：基因）pheatmap(  mat = norm_data[c("B16", "KPC", "MC38"),],  # 选择目标模型  scale = "none",          # 不进行额外标准化（已为log2倍变化）  cluster_rows = FALSE,    # 不聚类模型（保持B16、KPC、MC38顺序）  cluster_cols = FALSE,    # 不聚类基因（保持输入列表顺序）  border_color = NA,       # 隐藏单元格边框  show_colnames = TRUE,    # 显示基因名  main = "ECM Genes Expression",  # 图标题（ECM相关基因表达变化）  display_numbers = F      # 不显示具体数值)######## Figure J：UMAP密度 contour 图（以B16模型为例）# 核心目的：展示ADAM12-KO后，CAF亚群在UMAP空间的分布变化及密度聚集特征# 注：UMAP是单细胞数据降维可视化方法，密度contour可突出细胞富集区域#### Example: B16 模型（KPC、MC38模型可复用此代码，仅需替换输入数据）library(ggnewscale)  # 支持多套配色方案（用于同时展示细胞亚群和密度）# 1. 读取数据：B16模型清洁后的CAF单细胞对象（含UMAP坐标和细胞亚群注释）B16_CAF<-readRDS("./B16_CAF_cleaned2_0613.RDS")# 2. 数据整理：提取UMAP坐标和元数据（处理组、细胞亚群）data<-B16_CAF@reductions$umap@cell.embeddings  # UMAP降维后的二维坐标（umap_1、umap_2）data<-cbind(data,B16_CAF@meta.data)  # 合并元数据（含Condition：Ctrl/KO；cell_pro2：CAF亚群注释）# 3. 筛选目标处理组数据（此处示例为KO组，Ctrl组可替换subset条件）dd<-subset(data,Condition=="KO"  )  # 筛选KO组数据（替换为"Ctrl"可绘制对照组）# 4. 定义配色方案：为不同CAF亚群分配颜色col<-c("#86B8AE", "#C5D2C0" ,"#D8D8D8" ,"#DDB5A5" ,"#ACD16A" ,"#B1B4D4", "#7EAAC9")# 5. 绘制UMAP+密度contour图p<-ggplot(dd, aes(x=umap_1, y=umap_2))+  # 第一层：绘制非目标亚群的散点（透明色，避免遮挡密度图）  geom_point(data = subset(dd,cell_pro2 !=c("Apod+_Pi16+_Fib")),             aes(color=cell_pro2),size=3)+  # 第二层：绘制目标亚群（Apod+_Pi16+_Fib，祖细胞样CAF）的散点（特定颜色+低透明度）  geom_point(data = subset(dd,cell_pro2 %in% c("Apod+_Pi16+_Fib")),             color=alpha(col[6],alpha=0.2),size=3)+  # 亚群颜色配置（低透明度，避免覆盖密度轮廓）  scale_color_manual(values = alpha(col[c(1:5,7)],alpha=0.2))+   new_scale_color()+  # 启动新配色方案（用于密度contour）  stat_density_2d(aes(color=..level..))+  # 绘制二维密度轮廓（反映细胞聚集程度）  scale_color_gradientn(colors = colorRampPalette(brewer.pal(name = "Greys",n=9)[c(2:8)])(200))+  # 密度配色（灰色梯度）  theme_void()+  # 隐藏坐标轴、背景等冗余元素（聚焦UMAP分布）  # 调整坐标轴范围（预留边缘空间，避免细胞点被截断）  scale_x_continuous(limits=c(min(data$umap_1) - 0.1*diff(range(data$umap_1)),max(data$umap_1) + 0.1*diff(range(data$umap_1))))+  scale_y_continuous(limits=c(min(data$umap_2) - 0.1*diff(range(data$umap_2)),max(data$umap_2) + 0.1*diff(range(data$umap_2))))# 输出图形p