######################################################################
# 简化版：多数据集单细胞预处理 + Harmony整合
# 用法：整个脚本分块跑（在RStudio里一段一段执行），
# 遇到 NULL 的地方，先看窗口里的图/数字，自己填完再往下跑。
######################################################################
library(Seurat)
library(dplyr)
library(tidyr)
library(harmony)
library(bluster) # 算轮廓系数用，比cluster::silhouette快
library(scDblFinder)
library(babelgene) # 小鼠转人ortholog
library(patchwork)
setwd("E:/OMV/宿主互作/single_cell/数据挖掘/多数据集整合")
set.seed(1)
## ========== 1. 读入7个样本 ==========
sample_info <- data.frame(
dataset = c("GSE190262","GSE190262","GSE220594","GSE220594",
"GSE252663","GSE252663","GSE252663"),
dir = c("GSE190262_GSM5718727_ctrl","GSE190262_GSM5718728_KP",
"GSE220594_GSM6807161_ctrl","GSE220594_GSM6807162_KP",
"GSE252663_GSM8004971_KP","GSE252663_GSM8004972_KP",
"GSE252663_GSM8004973_ctrl"),
label = c("GSE190262_Sham","GSE190262_hvKp","GSE220594_Sham","GSE220594_hvKp",
"GSE252663_hvKp_1","GSE252663_hvKp_2","GSE252663_Sham"),
condition = c("Sham","hvKp","Sham","hvKp","hvKp","hvKp","Sham")
)
seurat_list <- list()
for (i in 1:nrow(sample_info)) {
counts <- Read10X(sample_info$dir[i])
obj <- CreateSeuratObject(counts, project = sample_info$label[i],
min.cells = 3, min.features = 200)
obj$dataset <- sample_info$dataset[i]
obj$sample <- sample_info$label[i]
obj$condition <- sample_info$condition[i]
seurat_list[[i]] <- obj
}
lung <- merge(seurat_list[[1]], y = seurat_list[-1], add.cell.ids = sample_info$label)
## ========== 2. QC：先看图/看分位数，自己定阈值 ==========
lung[["percent.mt"]] <- PercentageFeatureSet(lung, pattern = "^mt-")
lung[["percent.hb"]] <- PercentageFeatureSet(
lung, features = grep("^Hb[ab]-", rownames(lung), value = TRUE)
)
VlnPlot(lung, features = c("nFeature_RNA", "nCount_RNA", "percent.mt", "percent.hb"),
group.by = "sample", pt.size = 0, ncol = 4)
quantile(lung$nFeature_RNA, seq(0.01, 0.10, 0.01))
quantile(lung$percent.mt, seq(0.90, 1.00, 0.01))
quantile(lung$percent.hb, seq(0.90, 1.00, 0.01))
# 看完上面的图和分位数，把下面4个值改成你自己的判断，再往下跑
qc_min_features <- 200
qc_max_features <- 6000
qc_max_percent_mt <- 20
qc_max_percent_hb <- 10
lung <- subset(lung, subset = nFeature_RNA > qc_min_features & nFeature_RNA < qc_max_features &
percent.mt < qc_max_percent_mt & percent.hb < qc_max_percent_hb)
## ========== 3. 每个样本单独去doublet ==========
lung_list <- SplitObject(lung, split.by = "sample")
lung_list <- lapply(lung_list, function(o) {
sce <- as.SingleCellExperiment(o)
sce <- scDblFinder(sce)
o$scDblFinder.class <- sce$scDblFinder.class
subset(o, subset = scDblFinder.class == "singlet")
})
lung <- merge(lung_list[[1]], y = lung_list[-1])
lung <- JoinLayers(lung)
## ========== 4.（可选）去解离/应激拉丝细胞 ==========
# 需要自己下载解离基因集，放到 markers/coregene_df-FALSE-v3.csv
# 没有这个文件就跳过这一段，不影响后面流程
lung <- NormalizeData(lung)
dis_file <- "markers/coregene_df-FALSE-v3.csv"
if (file.exists(dis_file)) {
dis_genes <- read.csv(dis_file) %>%
arrange(PValue) %>% slice(1:200) %>% pull(gene_symbol) %>% unique()
dis_genes <- intersect(dis_genes, rownames(lung))
lung <- AddModuleScore(lung, features = list(dis_genes), name = "dissociation_score")
FeaturePlot(lung, features = "dissociation_score1")
# 看完分布，自己定剔除比例，默认剔除最高1%，想改就改这个数
dissociation_cutoff_pct <- 0.99
lung <- subset(lung, subset = dissociation_score1 <
quantile(lung$dissociation_score1, dissociation_cutoff_pct))
}
## ========== 5. Harmony整合（用dataset+sample两个批次变量） ==========
lung[["RNA"]] <- split(lung[["RNA"]], f = lung$dataset)
lung <- lung %>%
NormalizeData() %>%
FindVariableFeatures(nfeatures = 2000) %>%
ScaleData() %>%
RunPCA(npcs = 40)
###############harmony整合#########
lung <- IntegrateLayers(
lung, method = HarmonyIntegration, orig.reduction = "pca",
new.reduction = "harmony", group.by.vars = c("dataset", "sample")
)
lung <- JoinLayers(lung)
##### 6. 选dims：几个候选值一起画出来，自己挑###########
## 法1：---- 累积方差贡献量化 ----
pct <- lung[["pca"]]@stdev^2 / sum(lung[["pca"]]@stdev^2) * 100
cumu <- cumsum(pct)
co1 <- which(cumu > 90 & pct < 5)[1]
co2 <- sort(
which((pct[1:(length(pct)-1)] - pct[2:length(pct)]) > 0.1),
decreasing = TRUE
)[1] + 1
cat("co1 =", co1, " co2 =", co2, "\n")
pcs_suggested <- min(co1, co2, na.rm = TRUE)
cat("量化法建议的PC数：", pcs_suggested, "\n")
## 法2---- ElbowPlot看肘部 ----
ElbowPlot(lung, ndims = 40)
##法3：绘图
dims_try <- c(10,15,pcs_suggested,20,30,33,40) # 把量化法给的值也加进候选里
dims_plots <- lapply(dims_try, function(d) {
lung <- RunUMAP(lung, reduction = "harmony", dims = 1:d, reduction.name = paste0("umap", d))
DimPlot(lung, reduction = paste0("umap", d), group.by = "dataset") +
ggtitle(paste0("dims=1:", d)) + NoLegend()
})
pdf("UMAP_compare_dims.pdf", width = 15, height = 10)
print(wrap_plots(dims_plots, ncol = 3)) # 6张图，3列2行
dev.off()
# 看完图，自己填最终用的dims
use_dims <- 20
lung <- RunUMAP(lung, reduction = "harmony", dims = 1:use_dims, reduction.name = "umap", n.neighbors = 40, min.dist =0.1, spread = 0.3)
lung <- FindNeighbors(lung, reduction = "harmony", dims = 1:use_dims)
##### 7. 选resolution：轮廓系数 + 多分辨率UMAP ==========
####平均轮廓系数 mean silhouette####
res_try <- seq(0.1, 1, 0.1) # 想改区间自己改
sil_score <- sapply(res_try, function(r) {
lung <- FindClusters(lung, resolution = r)
mean(approxSilhouette(Embeddings(lung, "harmony")[, 1:use_dims], lung$seurat_clusters)$width)
})
plot(res_try, sil_score, type = "b", xlab = "resolution", ylab = "mean silhouette")
res_plots <- lapply(res_try, function(r) {
lung <- FindClusters(lung, resolution = r)
DimPlot(lung, reduction = "umap", label = TRUE) +
ggtitle(paste0("res=", r)) + NoLegend()
})
pdf("UMAP_compare_resolutions.pdf", width = 20, height = 12)
print(wrap_plots(res_plots, ncol = 4))
dev.off()
# 结合轮廓系数曲线 + UMAP + 后面的marker表达，自己定最终resolution
use_resolution <- 0.1
lung <- FindClusters(lung, resolution = use_resolution)
p_cluster <- DimPlot(lung, reduction = "umap", label = TRUE) + NoLegend() + ggtitle("Cluster")
p_dataset <- DimPlot(lung, reduction = "umap", group.by = "dataset") + ggtitle("Dataset")
p_condition <- DimPlot(lung, reduction = "umap", group.by = "condition") + ggtitle("Condition")
pdf("UMAP_final.pdf", width = 18, height = 6)
print(p_cluster | p_dataset | p_condition)
dev.off()
## ========== 8. 每个数据集单独看一次UMAP（按sample/condition着色） ==========
for (ds in unique(lung$dataset)) {
print(
DimPlot(subset(lung, dataset == ds), reduction = "umap", group.by = "sample") +
ggtitle(ds)
)
}
saveRDS(lung, "lung_integrated_before_annotation.rds")
readRDS("lung_integrated_before_annotation.rds")
## ========== 9. marker查看 + 人工注释 ==========
markers <- list(
T_cell = c("Cd3e","Cd3d","Cd4","Cd8a","Trac"),
NK = c("Ncr1","Klrb1c","Gzmb","Prf1"),
B = c("Cd19","Cd79a","Ms4a1","Cd79b"),
Plasma = c("Jchain","Mzb1","Xbp1","Sdc1"),
Neutrophil = c("S100a8","S100a9","Retnlg","Ly6g","Cxcr2"),
Monocyte_Macrophage = c("Lyz2","Cd68","Itgam","Csf1r","Adgre1"),
Alveolar_Mac = c("Marco","Siglecf","Pparg","Ear2"),
MoDerived_Mac = c("Lyz2","Ccr2","Fcgr1","Msr1"),
DC = c("Itgax","Flt3","Xcr1","Clec9a","Ccr7"),
Endothelial = c("Pecam1","Cldn5","Kdr","Vwf"),
Epithelial = c("Epcam","Krt8","Krt18"),
AT1 = c("Ager","Pdpn","Hopx"),
AT2 = c("Sftpc","Sftpa1","Sftpb","Lamp3"),
Ciliated = c("Foxj1","Tppp3","Pifo"),
Club = c("Scgb1a1","Scgb3a2"),
Fibroblast = c("Col1a1","Col1a2","Pdgfra","Dcn"),
SmoothMuscle = c("Acta2","Tagln","Myh11"),
RBC = c("Hba-a1","Hba-a2","Hbb-bs","Hbb-bt","Alas2"),
Proliferating = c("Mki67","Top2a","Stmn1","Cdk1","Ccnb2")
)
marker_features <- intersect(unique(unlist(markers)), rownames(lung))
DotPlot(lung, features = marker_features) + RotatedAxis()
all_markers <- FindAllMarkers(lung, only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25)
write.csv(all_markers, "cluster_markers.csv", row.names = FALSE)
top_markers <- all_markers %>% group_by(cluster) %>%
arrange(desc(avg_log2FC), .by_group = TRUE) %>% slice_head(n = 15) %>%
summarise(top_markers = paste(gene, collapse = ";"), .groups = "drop")
write.csv(top_markers, "cluster_top15_markers.csv", row.names = FALSE)
annotation_file <- "cluster_to_celltype.csv"
if (!file.exists(annotation_file)) {
clusters <- sort(levels(Idents(lung)))
write.csv(
data.frame(cluster = clusters, celltype = paste0("Cluster_", clusters),
top_markers = top_markers$top_markers[match(clusters, top_markers$cluster)]),
annotation_file, row.names = FALSE
)
stop("已生成 ", annotation_file, "，根据 cluster_markers.csv / DotPlot 手动填好celltype列后重新运行。")
}
cluster_map <- read.csv(annotation_file, colClasses = "character")
lung$celltype <- cluster_map$celltype[match(as.character(Idents(lung)), cluster_map$cluster)]
Idents(lung) <- "celltype"
DimPlot(lung, reduction = "umap", group.by = "celltype", label = TRUE, repel = TRUE) + NoLegend()
for (ds in unique(lung$dataset)) {
print(
DimPlot(subset(lung, dataset == ds), reduction = "umap", group.by = "celltype",
label = TRUE, repel = TRUE) + NoLegend() + ggtitle(ds)
)
}
saveRDS(lung, "lung_annotated.rds")
## ========== 10. 剔除 artifact celltype，导出宿主表达矩阵（用于 MicrobioLink） ==========
library(Seurat)
library(Matrix)
library(dplyr)
library(tidyr)
## 输出目录要和 05_preflight_check.py 默认路径一致
dir.create("inputs", showWarnings = FALSE, recursive = TRUE)
## 1. 去掉 artifact / 低质量细胞类型
artifact_pattern <- "Doublet|LowQuality|RBC|Uncertain|Cycl|Proliferat"
keep_celltypes <- grep(
artifact_pattern,
unique(lung$celltype),
ignore.case = TRUE,
invert = TRUE,
value = TRUE
)
lung_host <- subset(lung, subset = celltype %in% keep_celltypes)
lung_host$celltype <- droplevels(factor(lung_host$celltype))
lung_host$condition <- as.character(lung_host$condition)
## 检查 condition 名称是否正确
print(table(lung_host$condition))
if (!all(c("hvKp", "Sham") %in% unique(lung_host$condition))) {
stop("condition 中必须包含 hvKp 和 Sham，请检查 lung_host$condition 的命名。")
}
lung_host$ct_cond <- paste(lung_host$celltype, lung_host$condition, sep = "_")
groups <- sort(unique(lung_host$ct_cond))
## 2. 提取 counts 和 data
counts <- GetAssayData(lung_host, layer = "counts")
data_norm <- GetAssayData(lung_host, layer = "data")
## 3. 计算每个 celltype_condition 中的表达比例 pct_expr
pct_mat <- sapply(groups, function(g) {
cells_g <- colnames(lung_host)[lung_host$ct_cond == g]
Matrix::rowMeans(counts[, cells_g, drop = FALSE] > 0)
})
pct_mat <- as.data.frame(pct_mat)
colnames(pct_mat) <- groups
pct_mat$symbol <- rownames(pct_mat)
## 4. 生成 0/1 表达矩阵：pct >= 0.10 认为表达
expressed <- pct_mat
expressed[groups] <- (expressed[groups] >= 0.10) * 1
## 只对至少在一个 group 中表达的 mouse gene 做同源转换
expressed_symbols <- expressed$symbol[rowSums(expressed[groups]) > 0]
ortho <- orthologs(
genes = expressed_symbols,
species = "mouse",
human = FALSE
)
ortho <- ortho %>%
select(symbol, human_symbol) %>%
distinct() %>%
filter(!is.na(symbol), !is.na(human_symbol))
## 5. 导出 MicrobioLink 需要的 human 0/1 表达矩阵
host_human <- expressed %>%
inner_join(ortho, by = "symbol") %>%
select(-symbol) %>%
group_by(human_symbol) %>%
summarise(across(all_of(groups), max), .groups = "drop")
write.csv(
host_human,
"inputs/host_expressed_human.csv",
row.names = FALSE
)
## 6. 计算每个 celltype_condition 中的平均表达 avg_expr
avg_mat <- sapply(groups, function(g) {
cells_g <- colnames(lung_host)[lung_host$ct_cond == g]
Matrix::rowMeans(data_norm[, cells_g, drop = FALSE])
})
avg_mat <- as.data.frame(avg_mat)
colnames(avg_mat) <- groups
avg_mat$symbol <- rownames(avg_mat)
## 7. avg_expr 转成长表，并映射到 human_symbol
avg_long <- avg_mat %>%
pivot_longer(
cols = all_of(groups),
names_to = "group",
values_to = "avg_expr"
) %>%
inner_join(ortho, by = "symbol") %>%
mutate(
condition = ifelse(grepl("_hvKp$", group), "hvKp", "Sham"),
celltype = sub("_(hvKp|Sham)$", "", group)
) %>%
group_by(human_symbol, celltype, condition) %>%
summarise(avg_expr = max(avg_expr), .groups = "drop")
## 8. pct_expr 也转成长表，并映射到 human_symbol
pct_long <- pct_mat %>%
pivot_longer(
cols = all_of(groups),
names_to = "group",
values_to = "pct_expr"
) %>%
inner_join(ortho, by = "symbol") %>%
mutate(
condition = ifelse(grepl("_hvKp$", group), "hvKp", "Sham"),
celltype = sub("_(hvKp|Sham)$", "", group)
) %>%
group_by(human_symbol, celltype, condition) %>%
summarise(pct_expr = max(pct_expr), .groups = "drop")
## 9. 合并 avg_expr 和 pct_expr
expr_pair_long <- avg_long %>%
full_join(
pct_long,
by = c("human_symbol", "celltype", "condition")
) %>%
mutate(
avg_expr = ifelse(is.na(avg_expr), 0, avg_expr),
pct_expr = ifelse(is.na(pct_expr), 0, pct_expr)
)
## 10. 转成 hvKp vs Sham 宽表，生成 preflight 需要的标准列名
expr_pair <- expr_pair_long %>%
pivot_wider(
id_cols = c(human_symbol, celltype),
names_from = condition,
values_from = c(avg_expr, pct_expr),
values_fill = 0
)
## 防止某些 celltype 里缺少 Sham 或 hvKp 时列不存在
required_cols <- c(
"avg_expr_hvKp",
"avg_expr_Sham",
"pct_expr_hvKp",
"pct_expr_Sham"
)
for (cc in required_cols) {
if (!cc %in% colnames(expr_pair)) {
expr_pair[[cc]] <- 0
}
}
expr_pair <- expr_pair %>%
mutate(
delta_pct_hvKp_vs_Sham = pct_expr_hvKp - pct_expr_Sham,
log2FC_expr_hvKp_vs_Sham = log2(
(expm1(avg_expr_hvKp) + 1e-6) /
(expm1(avg_expr_Sham) + 1e-6)
)
) %>%
select(
human_symbol,
celltype,
avg_expr_hvKp,
avg_expr_Sham,
pct_expr_hvKp,
pct_expr_Sham,
delta_pct_hvKp_vs_Sham,
log2FC_expr_hvKp_vs_Sham
)
write.csv(
expr_pair,
"inputs/host_expression_hvKp_vs_Sham.csv",
row.names = FALSE
)
## 12. 简单检查输出
cat("\n[OK] 已输出：inputs/host_expressed_human.csv\n")
cat("[OK] 已输出：inputs/host_expression_hvKp_vs_Sham.csv\n")
cat("host_expressed_human.csv 列名：\n")
print(colnames(host_human))
cat("\nhost_expression_hvKp_vs_Sham.csv 列名：\n")
print(colnames(expr_pair))
cat("\ncelltype 数量：\n")
print(length(unique(expr_pair$celltype)))
cat("\ncelltype 列表：\n")
print(sort(unique(expr_pair$celltype)))
## ========== 11. 读取已有marker表（跳过FindAllMarkers） ==========
## ========== 11. 用cluster_markers.csv + cluster_to_celltype.csv 生成celltype top marker ==========
library(Seurat)
library(dplyr)
library(tidyr)
library(ggplot2)
library(pheatmap)
cluster_markers <- read.csv("cluster_markers.csv", stringsAsFactors = FALSE)
cluster_map <- read.csv("cluster_to_celltype.csv", colClasses = "character")
cluster_markers <- cluster_markers %>%
mutate(celltype = cluster_map$celltype[match(as.character(cluster), cluster_map$cluster)])
celltype_markers <- cluster_markers %>%
group_by(celltype, gene) %>%
slice_max(avg_log2FC, n = 1, with_ties = FALSE) %>%
ungroup()
write.csv(celltype_markers, "celltype_markers_merged.csv", row.names = FALSE)
n_top <- 4
top_genes_df <- celltype_markers %>%
group_by(celltype) %>%
arrange(desc(avg_log2FC), .by_group = TRUE) %>%
slice_head(n = n_top) %>%
ungroup()
write.csv(top_genes_df, "celltype_top_markers.csv", row.names = FALSE)
celltype_order <- c("T_cell","NK","B_cell",
"Interstitial_Mac","Alveolar_Mac","Neutrophil","Megakaryocyte_Platelet",
"Endothelial","Fibroblast","SmoothMuscle","Mesothelial",
"AT1","AT2","Ciliated")
celltype_order <- intersect(celltype_order, unique(lung$celltype))
## ---- 关键修正1：先把celltype不在celltype_order里的细胞剔除掉，避免NA identity ----
lung_plot <- subset(lung, subset = celltype %in% celltype_order)
lung_plot$celltype <- droplevels(factor(lung_plot$celltype, levels = celltype_order))
Idents(lung_plot) <- "celltype"
table(lung_plot$celltype) # 跑完看一眼，确认没有NA、每类都有细胞数
top_genes_df$celltype <- factor(top_genes_df$celltype, levels = celltype_order)
top_genes_df <- top_genes_df %>% arrange(celltype)
gene_order <- unique(top_genes_df$gene)
gene_order <- intersect(gene_order, rownames(lung_plot)) # 防止基因名对不上报错
## ========== 12. 气泡图 DotPlot ==========
p_dot <- DotPlot(lung_plot, features = gene_order, group.by = "celltype") +
RotatedAxis() +
scale_color_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
labs(x = NULL, y = NULL)
ggsave("DotPlot_top_markers.pdf", p_dot,
width = 0.25 * length(gene_order) + 3,
height = 0.3 * length(celltype_order) + 2)
## ========== 13. 热图：celltype平均表达 ==========
avg_exp <- AverageExpression(lung_plot, features = gene_order, group.by = "celltype",
assay = "RNA", layer = "data")$RNA
## ---- 关键修正2：AverageExpression会把identity名里的"_"换成"-"，这里手动对应回来 ----
celltype_order_dash <- gsub("_", "-", celltype_order)
avg_exp <- avg_exp[, celltype_order_dash, drop = FALSE]
colnames(avg_exp) <- celltype_order # 换回原来带下划线的名字，方便画图好看
avg_exp_scaled <- t(scale(t(avg_exp)))
pdf("Heatmap_top_markers_avgexpr.pdf", width = 5, height = 0.25 * length(gene_order) + 2)
pheatmap(avg_exp_scaled,
cluster_rows = FALSE, cluster_cols = FALSE,
color = colorRampPalette(c("blue","white","red"))(100),
border_color = NA, fontsize_row = 8)
dev.off()
# 单细胞水平热图（downsample避免文件过大）
lung_sub <- subset(lung_plot, downsample = 300)
p_heat_sc <- DoHeatmap(lung_sub, features = gene_order, group.by = "celltype", size = 3) +
scale_fill_gradientn(colors = c("blue","white","red"))
ggsave("DoHeatmap_top_markers_singlecell.pdf", p_heat_sc,
width = 10, height = 0.25 * length(gene_order) + 3)
## ========== 14. 细胞比例堆叠图（hvKp vs Sham） ==========
## ========== 14. 细胞比例堆叠图（改进版：加百分比标签 + 重命名分组 + 换配色） ==========
library(RColorBrewer)
library(scales)
# ---- 统一配色：按celltype_order固定顺序上色，保证三张图配色/图例顺序完全一致 ----
n_types <- length(celltype_order)
pal <- colorRampPalette(brewer.pal(12, "Paired"))(n_types)
names(pal) <- celltype_order
# ---- 重命名条件：Sham -> Control, hvKp -> KP，并让Control排在左边 ----
recode_condition <- function(x) {
factor(dplyr::recode(x, "Sham" = "Control", "hvKp" = "KP"),
levels = c("Control", "KP"))
}
# 只显示占比较大的标签，避免小碎片文字堆在一起看不清（阈值可自己调）
label_threshold <- 0.03
## ---- 14.1 每个样本单独一根柱子 ----
prop_sample <- lung_plot@meta.data %>%
dplyr::count(sample, dataset, condition, celltype) %>%
dplyr::group_by(sample) %>%
dplyr::mutate(fraction = n / sum(n)) %>%
dplyr::ungroup() %>%
dplyr::mutate(celltype = factor(celltype, levels = celltype_order),
condition = recode_condition(condition))
p_prop_sample <- ggplot(prop_sample, aes(x = sample, y = fraction, fill = celltype)) +
geom_bar(stat = "identity", position = "fill", color = "white", linewidth = 0.2) +
geom_text(data = subset(prop_sample, fraction >= label_threshold),
aes(label = percent(fraction, accuracy = 1)),
position = position_fill(vjust = 0.5), size = 2.3, color = "black") +
facet_grid(~ dataset, scales = "free_x", space = "free_x") +
scale_fill_manual(values = pal) +
scale_y_continuous(labels = percent) +
theme_bw(base_size = 11) +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid = element_blank()) +
labs(x = NULL, y = "Fraction of cells", fill = "Cell type")
ggsave("Proportion_stackedbar_bysample.pdf", p_prop_sample, width = 11, height = 6)
## ---- 14.2 pool全部细胞按condition（仅展示用） ----
prop_condition_pooled <- lung_plot@meta.data %>%
dplyr::count(condition, celltype) %>%
dplyr::group_by(condition) %>%
dplyr::mutate(fraction = n / sum(n)) %>%
dplyr::ungroup() %>%
dplyr::mutate(celltype = factor(celltype, levels = celltype_order),
condition = recode_condition(condition))
p_prop_condition <- ggplot(prop_condition_pooled, aes(x = condition, y = fraction, fill = celltype)) +
geom_bar(stat = "identity", position = "fill", color = "white", linewidth = 0.3) +
geom_text(data = subset(prop_condition_pooled, fraction >= label_threshold),
aes(label = percent(fraction, accuracy = 1)),
position = position_fill(vjust = 0.5), size = 3, color = "black") +
scale_fill_manual(values = pal) +
scale_y_continuous(labels = percent) +
theme_bw(base_size = 12) +
theme(panel.grid = element_blank()) +
labs(x = NULL, y = "Fraction of cells", fill = "Cell type",
title = "Pooled across datasets, exploratory (Control n=1)")
ggsave("Proportion_stackedbar_bycondition_pooled.pdf", p_prop_condition, width = 6.5, height = 6)
## ---- 14.3 先按样本算比例再取mean（推荐主图）----
prop_summary <- prop_sample %>%
dplyr::group_by(condition, celltype) %>%
dplyr::summarise(mean_fraction = mean(fraction), sd_fraction = sd(fraction),
n_sample = dplyr::n(), .groups = "drop")
write.csv(prop_summary, "Proportion_summary_by_condition.csv", row.names = FALSE)
p_prop_summary <- ggplot(prop_summary, aes(x = condition, y = mean_fraction, fill = celltype)) +
geom_bar(stat = "identity", position = "fill", color = "white", linewidth = 0.3) +
geom_text(data = subset(prop_summary, mean_fraction >= label_threshold),
aes(label = percent(mean_fraction, accuracy = 1)),
position = position_fill(vjust = 0.5), size = 3, color = "black") +
scale_fill_manual(values = pal) +
scale_y_continuous(labels = percent) +
theme_bw(base_size = 12) +
theme(panel.grid = element_blank()) +
labs(x = NULL, y = "Mean fraction (per-sample averaged)", fill = "Cell type")
ggsave("Proportion_stackedbar_bycondition_samplemean.pdf", p_prop_summary, width = 6.5, height = 6)
######################################################################
# 02 多数据集整合后差异分析 → 每个细胞类型导出 DEG
#
# 输入：
# lung_annotated_multi_dataset.rds
#
# 输出：
# DEG_multi_dataset/{celltype}_DEG.csv
# DEG_multi_dataset/celltype_deg_summary_multi_dataset.csv
# DEG_multi_dataset/DEG_multi_dataset_pseudobulk_skip_log.csv
#
# 设计：
# hvKp = 4 个样本，Sham = 3 个样本
# pseudobulk 按 sample 聚合，每个细胞类型单独做 DESeq2。
#
# 关键原则：
# 1) 差异分析使用 RNA counts，不使用 integrated.cca。
# 2) 分组名固定为 Sham / hvKp。
# 3) 多数据集分析优先使用 design = ~ dataset + condition；
# 如果某个细胞类型内模型不满秩，则自动退回 ~ condition。
# 4) 输出列名固定为 human_symbol, avg_log2FC, p_val_adj，方便对接 TieDIE。
######################################################################
options(stringsAsFactors = FALSE)
base_dir <- "E:/OMV/宿主互作/single_cell/数据挖掘/多数据集整合harmony"
setwd(base_dir)
suppressPackageStartupMessages({
library(Seurat)
library(dplyr)
library(Matrix)
library(babelgene)
library(DESeq2)
})
######################################################################
# 0) 工具函数
######################################################################
sanitize_label <- function(x) {
x <- as.character(x)
x <- gsub("[^A-Za-z0-9_]+", "_", x)
x <- gsub("_+", "_", x)
x <- gsub("^_|_$", "", x)
x
}
get_counts <- function(obj, assay = "RNA") {
tryCatch(
GetAssayData(obj, assay = assay, layer = "counts"),
error = function(e) GetAssayData(obj, assay = assay, slot = "counts")
)
}
empty_human_deg <- function() {
data.frame(
human_symbol = character(),
avg_log2FC = numeric(),
p_val_adj = numeric(),
stringsAsFactors = FALSE
)
}
write_empty_deg <- function(outdir, CT, reason) {
write.csv(
empty_human_deg(),
file.path(outdir, sprintf("%s_DEG.csv", CT)),
row.names = FALSE
)
data.frame(
celltype = CT,
status = "skipped",
reason = reason,
n_genes = 0,
stringsAsFactors = FALSE
)
}
format_deg_output <- function(res_df, mouse_col = "mouse_symbol", fc_col, p_col) {
res_df <- res_df[!is.na(res_df[[mouse_col]]), ]
if (nrow(res_df) == 0) {
return(empty_human_deg())
}
ortho <- orthologs(genes = unique(res_df[[mouse_col]]), species = "mouse", human = FALSE)
if (is.null(ortho) || nrow(ortho) == 0) {
return(empty_human_deg())
}
out <- merge(
res_df,
ortho[, c("symbol", "human_symbol")],
by.x = mouse_col,
by.y = "symbol"
)
if (nrow(out) == 0) {
return(empty_human_deg())
}
out <- out[, c("human_symbol", fc_col, p_col)]
colnames(out) <- c("human_symbol", "avg_log2FC", "p_val_adj")
out <- out[!is.na(out$human_symbol), ]
out$avg_log2FC <- as.numeric(out$avg_log2FC)
out$p_val_adj <- as.numeric(out$p_val_adj)
out <- out %>%
group_by(human_symbol) %>%
summarise(
avg_log2FC = avg_log2FC[which.max(abs(avg_log2FC))],
p_val_adj = suppressWarnings(min(p_val_adj, na.rm = TRUE)),
.groups = "drop"
) %>%
mutate(
p_val_adj = ifelse(is.infinite(p_val_adj), NA, p_val_adj)
) %>%
select(human_symbol, avg_log2FC, p_val_adj)
out
}
######################################################################
# 1) 读入对象
######################################################################
rds_file <- "lung_annotated.rds"
if (!file.exists(rds_file)) {
stop(
"找不到 ", rds_file,
"\n请先运行 01 脚本，并完成 cluster_to_celltype_multi_dataset.csv 的人工细胞注释。"
)
}
lung <- readRDS(rds_file)
if (!"celltype" %in% colnames(lung@meta.data)) {
stop("对象中没有 celltype 列，请先完成 01 脚本的细胞注释。")
}
lung$celltype <- sanitize_label(lung$celltype)
lung$condition <- factor(as.character(lung$condition), levels = c("Sham", "hvKp"))
lung$dataset <- factor(as.character(lung$dataset))
lung$sample <- as.character(lung$sample)
if (!all(na.omit(unique(lung$condition)) %in% c("Sham", "hvKp"))) {
stop("condition 必须只能是 Sham 或 hvKp。")
}
bad_celltype_pattern <- "Cycl|Proliferat|Doublet|LowQuality|Low_quality|RBC|Erythrocyte|Hemoglobin|Uncertain"
keep_cells <- colnames(lung)[!grepl(bad_celltype_pattern, as.character(lung$celltype), ignore.case = TRUE)]
lung <- subset(lung, cells = keep_cells)
lung$celltype <- droplevels(factor(lung$celltype))
Idents(lung) <- "celltype"
outdir <- file.path(base_dir, "DEG_multi_dataset")
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
cat("\n用于 DEG 的样本分布：\n")
print(table(lung$dataset, lung$condition))
cat("\n用于 DEG 的细胞类型 × 条件细胞数：\n")
print(table(lung$celltype, lung$condition))
write.csv(as.data.frame(table(lung$dataset, lung$condition)),
file.path(outdir, "DEG_input_sample_distribution.csv"),
row.names = FALSE)
write.csv(as.data.frame(table(lung$celltype, lung$condition)),
file.path(outdir, "DEG_input_celltype_condition_cell_number.csv"),
row.names = FALSE)
celltypes <- sort(unique(as.character(lung$celltype)))
cat("\n将处理这些细胞类型：\n")
print(celltypes)
#################pseudobulk + DESeq2###################################
run_pseudobulk <- function(lung,
celltypes,
outdir,
min_cells_per_celltype = 30,
min_cells_per_sample = 10,
min_samples_per_condition = 2) {
counts_all <- get_counts(lung, assay = "RNA")
meta <- lung@meta.data
skip_log <- list()
summary_log <- list()
for (CT in celltypes) {
cat("\n==== [pseudobulk] ", CT, " ====\n", sep = "")
cells_ct <- rownames(meta)[as.character(meta$celltype) == CT]
if (length(cells_ct) < min_cells_per_celltype) {
reason <- paste0("该细胞类型总细胞数 < ", min_cells_per_celltype)
cat(" 跳过：", reason, "\n")
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
meta_ct <- meta[cells_ct, , drop = FALSE]
sample_cell_n <- table(meta_ct$sample)
samp_ok <- names(sample_cell_n)[sample_cell_n >= min_cells_per_sample]
meta_ct <- meta_ct[meta_ct$sample %in% samp_ok, , drop = FALSE]
if (nrow(meta_ct) == 0) {
reason <- paste0("没有 sample 在该细胞类型中达到 ", min_cells_per_sample, " 个细胞")
cat(" 跳过：", reason, "\n")
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
sample_meta <- meta_ct %>%
select(sample, condition, dataset) %>%
distinct(sample, .keep_all = TRUE) %>%
arrange(sample)
sample_meta$condition <- factor(as.character(sample_meta$condition), levels = c("Sham", "hvKp"))
sample_meta$dataset <- droplevels(factor(as.character(sample_meta$dataset)))
cond_n <- table(sample_meta$condition)
cat(" pseudobulk 样本数：", paste(names(cond_n), cond_n, collapse = ", "), "\n")
if (length(cond_n) < 2 || any(cond_n < min_samples_per_condition)) {
reason <- paste0(
"该细胞类型中每组 pseudobulk 样本数不足 ",
min_samples_per_condition,
"；当前为 ",
paste(names(cond_n), cond_n, collapse = ", ")
)
cat(" 跳过：", reason, "\n")
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
samples <- sample_meta$sample
pb <- sapply(samples, function(s) {
cs <- rownames(meta_ct)[meta_ct$sample == s]
Matrix::rowSums(counts_all[, cs, drop = FALSE])
})
pb <- as.matrix(pb)
mode(pb) <- "integer"
colnames(pb) <- samples
col_data <- as.data.frame(sample_meta)
rownames(col_data) <- col_data$sample
col_data <- col_data[colnames(pb), , drop = FALSE]
# 低表达基因过滤：至少 2 个 pseudobulk 样本中 count >= 10
keep_genes <- rowSums(pb >= 10) >= 2
pb <- pb[keep_genes, , drop = FALSE]
if (nrow(pb) < 10) {
reason <- "过滤后可用于 DESeq2 的基因数 < 10"
cat(" 跳过：", reason, "\n")
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
# 优先用 dataset + condition；如果某细胞类型内模型不满秩，则退回 condition。
design_formula <- ~ dataset + condition
if (nlevels(col_data$dataset) < 2) {
design_formula <- ~ condition
} else {
mm <- model.matrix(design_formula, data = col_data)
if (qr(mm)$rank < ncol(mm)) {
cat(" dataset + condition 模型不满秩，退回 ~ condition\n")
design_formula <- ~ condition
}
}
dds <- tryCatch(
DESeqDataSetFromMatrix(
countData = round(pb),
colData = col_data,
design = design_formula
),
error = function(e) {
cat(" DESeqDataSetFromMatrix 失败：", conditionMessage(e), "\n")
NULL
}
)
if (is.null(dds)) {
reason <- "DESeqDataSetFromMatrix 失败"
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
dds <- tryCatch(
DESeq(dds, sfType = "poscounts", quiet = TRUE),
error = function(e) {
cat(" DESeq 失败：", conditionMessage(e), "\n")
NULL
}
)
if (is.null(dds)) {
reason <- "DESeq 失败"
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
res <- tryCatch(
as.data.frame(results(dds, contrast = c("condition", "hvKp", "Sham"))),
error = function(e) {
cat(" results 提取失败：", conditionMessage(e), "\n")
NULL
}
)
if (is.null(res) || nrow(res) == 0) {
reason <- "results 为空"
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
res$mouse_symbol <- rownames(res)
res <- res[!is.na(res$padj), , drop = FALSE]
if (nrow(res) == 0) {
reason <- "所有基因 padj 均为 NA"
cat(" 跳过：", reason, "\n")
skip_log[[CT]] <- write_empty_deg(outdir, CT, reason)
next
}
out <- format_deg_output(
res_df = res,
mouse_col = "mouse_symbol",
fc_col = "log2FoldChange",
p_col = "padj"
)
stopifnot(identical(colnames(out), c("human_symbol", "avg_log2FC", "p_val_adj")))
write.csv(out, file.path(outdir, sprintf("%s_DEG.csv", CT)), row.names = FALSE)
summary_log[[CT]] <- data.frame(
celltype = CT,
status = "success",
design = paste(deparse(design_formula), collapse = ""),
n_cells = nrow(meta_ct),
n_pseudobulk_samples = ncol(pb),
n_sham_samples = as.integer(cond_n["Sham"]),
n_hvkp_samples = as.integer(cond_n["hvKp"]),
n_genes_tested_mouse = nrow(res),
n_genes_output_human = nrow(out),
stringsAsFactors = FALSE
)
cat(sprintf(" 导出 %s_DEG.csv：%d human genes\n", CT, nrow(out)))
}
skip_df <- if (length(skip_log) > 0) {
bind_rows(skip_log)
} else {
data.frame(
celltype = character(),
status = character(),
reason = character(),
n_genes = integer(),
stringsAsFactors = FALSE
)
}
summary_df <- if (length(summary_log) > 0) {
bind_rows(summary_log)
} else {
data.frame()
}
write.csv(skip_df,
file.path(outdir, "DEG_multi_dataset_pseudobulk_skip_log.csv"),
row.names = FALSE)
write.csv(summary_df,
file.path(outdir, "celltype_deg_summary_multi_dataset.csv"),
row.names = FALSE)
invisible(list(summary = summary_df, skipped = skip_df))
}
######################################################################
######################################################################
# 4) 运行
######################################################################
res_pb <- run_pseudobulk(
lung = lung,
celltypes = celltypes,
outdir = outdir,
min_cells_per_celltype = 30,
min_cells_per_sample = 10,
min_samples_per_condition = 2
)
cat("\n全部完成！DEG 文件输出目录：\n")
cat(outdir, "\n")
cat("\n成功细胞类型：\n")
print(res_pb$summary)
cat("\n跳过细胞类型：\n")
print(res_pb$skipped)