【原】单细胞RNA-seq揭示TNBC的异质性（图表复现03）

前面的单细胞RNA-seq揭示TNBC的异质性（图表复现02）教程里面我们一起复现了文章“ Unravelling subclonal heterogeneity and aggressive disease states in TNBC through single-cell RNA-seq  ” 的Figure 2 ，这周继续来复现一下Figure 3的相关内容

复现图表

Fig3a

代码重复

1.操作准备流程

HSMM_allepith_clustering <- monocle_unsup_clust_plots(sceset_obj = sceset_ct[,which(colData(sceset_ct)$cell_types_cl_all == "epithelial")], 
                                                      mat_to_cluster = mat_ct[,which(colData(sceset_ct)$cell_types_cl_all == "epithelial")], 
                                                      anno_colors = anno_colors, name_in_phenodata = "cluster_allepith_regr_disp", 
                                                      disp_extra = 1, save_plots = 0, path_plots = NULL, 
                                                      type_pats = "allpats", regress_pat = 1, use_known_colors = 1, use_only_known_celltypes = 1)
table(HSMM_allepith_clustering$Cluster)
# 由于monocle功能的改变(降维和聚类细胞)，导致上皮细胞的聚类与本文最初的聚类稍有不同。为了重现性，我们读取了上皮细胞的原始聚类
original_clustering_epithelial <- readRDS(file = "original_clustering_epithelial.RDS")
table(original_clustering_epithelial)
HSMM_allepith_clustering$Cluster <- original_clustering_epithelial
clustering_allepith <- HSMM_allepith_clustering$Cluster


2.可视化操作

#pdf("fig3a.pdf")
plot_cell_clusters(HSMM_allepith_clustering, 2, 1, color = "Cluster", cell_size = 2) + 
  scale_color_manual(values = c("1" = "#ee204d", "2" = "#17806d", "3" = "#b2ec5d", "4" = "#cda4de", "5" = "#1974d2"))#保证与原图类似，横纵坐标进行转换
#dev.off()


图片展示

Fig3b

代码重复

1.操作准备流程

#正常标志物
ml_signature_long <- read.table("ML_signature.txt", sep = "\t", header = TRUE)
if (length(which(ml_signature_long$Symbol == "")) > 0)
  ml_signature_long <- ml_signature_long[-which(ml_signature_long$Symbol == ""),]
ml_signature_long <- ml_signature_long[order(ml_signature_long$Symbol, -abs(ml_signature_long$Average.log.fold.change) ), ]
ml_signature_long <- ml_signature_long[ !duplicated(ml_signature_long$Symbol), ]
ml_signature <- ml_signature_long[which(!is.na(match(ml_signature_long$Symbol, rownames(mat_ct)))), ]
ml_up <- ml_signature[which(ml_signature$Average.log.fold.change > 0), ]
ml_down <- ml_signature[which(ml_signature$Average.log.fold.change < 0), ]
idx_ml_up <- match(ml_up$Symbol, rownames(mat_ct))
idx_ml_down <- match(ml_down$Symbol, rownames(mat_ct))

basal_signature_long <- read.table("basal_signature.txt", sep = "\t", header = TRUE)
if (length(which(basal_signature_long$Symbol == "")) > 0)
  basal_signature_long <- basal_signature_long[-which(basal_signature_long$Symbol == ""),]
basal_signature_long <- basal_signature_long[order(basal_signature_long$Symbol, -abs(basal_signature_long$Average.log.fold.change) ), ]
basal_signature_long <- basal_signature_long[ !duplicated(basal_signature_long$Symbol), ]
basal_signature <- basal_signature_long[which(!is.na(match(basal_signature_long$Symbol, rownames(mat_ct)))), ]
basal_up <- basal_signature[which(basal_signature$Average.log.fold.change > 0), ]
basal_down <- basal_signature[which(basal_signature$Average.log.fold.change < 0), ]
idx_basal_up <- match(basal_up$Symbol, rownames(mat_ct))
idx_basal_down <- match(basal_down$Symbol, rownames(mat_ct))

lp_signature_long <- read.table("lp_signature.txt", sep = "\t", header = TRUE)
if (length(which(lp_signature_long$Symbol == "")) > 0)
  lp_signature_long <- lp_signature_long[-which(lp_signature_long$Symbol == ""),]
lp_signature_long <- lp_signature_long[order(lp_signature_long$Symbol, -abs(lp_signature_long$Average.log.fold.change) ), ]
lp_signature_long <- lp_signature_long[ !duplicated(lp_signature_long$Symbol), ]
lp_signature <- lp_signature_long[which(!is.na(match(lp_signature_long$Symbol, rownames(mat_ct)))), ]
lp_up <- lp_signature[which(lp_signature$Average.log.fold.change > 0), ]
lp_down <- lp_signature[which(lp_signature$Average.log.fold.change < 0), ]
idx_lp_up <- match(lp_up$Symbol, rownames(mat_ct))
idx_lp_down <- match(lp_down$Symbol, rownames(mat_ct))

normsig_avg_exprs <- apply(mat_ct, 2, function(x){
  
  avg_ml_up <- mean(x[idx_ml_up])
  avg_ml_down <- mean(x[idx_ml_down])
  avg_ml_both <- avg_ml_up - avg_ml_down
  
  avg_basal_up <- mean(x[idx_basal_up])
  avg_basal_down <- mean(x[idx_basal_down])
  avg_basal_both <- avg_basal_up - avg_basal_down
  
  avg_lp_up <- mean(x[idx_lp_up])
  avg_lp_down <- mean(x[idx_lp_down])
  avg_lp_both <- avg_lp_up - avg_lp_down
  
  return(c(avg_ml_up, avg_basal_up, avg_lp_up, avg_ml_both, avg_basal_both, avg_lp_both))
})
rownames(normsig_avg_exprs) <- c("avg_ml_up", "avg_basal_up", "avg_lp_up", "avg_ml_both", "avg_basal_both", "avg_lp_both")
all.equal(colnames(normsig_avg_exprs), rownames(pd_ct))
normsig_avg_exprs_epithelial <- normsig_avg_exprs[,which(pd_ct$cell_types_cl_all == "epithelial")]

normsig_avg_ups <- normsig_avg_exprs[c(1:3), ]
all.equal(colnames(normsig_avg_ups), rownames(pd_ct))
normsig_avg_ups_epithelial <- normsig_avg_ups[,which(pd_ct$cell_types_cl_all == "epithelial")]

normsig_avg_both <- normsig_avg_exprs[c(4:6),]
all.equal(colnames(normsig_avg_both), rownames(pd_ct))
normsig_avg_both_epithelial <- normsig_avg_both[,which(pd_ct$cell_types_cl_all == "epithelial")]

assignments_normsig_ups <- apply(normsig_avg_ups, 2, function(x){rownames(normsig_avg_ups)[which.max(x)]})
assignments_normsig_ups_epithelial <- assignments_normsig_ups[which(pd_ct$cell_types_cl_all == "epithelial")]
assignments_normsig_both <- apply(normsig_avg_both, 2, function(x){rownames(normsig_avg_both)[which.max(x)]})
assignments_normsig_both_epithelial <- assignments_normsig_both[which(pd_ct$cell_types_cl_all == "epithelial")]

#每个病人正常标志物的热图
pd_ct_epith <- pd_ct[which(pd_ct$cell_types_cl_all == "epithelial"),]
normsig_epith_pat_both <- list()
normsig_epith_pat_ups <- list()
pds_epith_ct <- list()
for (i in 1:length(patients_now)) {
  normsig_epith_pat_both[[i]] <- normsig_avg_both_epithelial[,which(pd_ct_epith$patient == patients_now[i])]
  normsig_epith_pat_ups[[i]] <- normsig_avg_ups_epithelial[,which(pd_ct_epith$patient == patients_now[i])]
  pds_epith_ct[[i]] <- pds_ct[[i]][which(pds_ct[[i]]$cell_types_cl_all == "epithelial"),]
}
names(normsig_epith_pat_both) <- patients_now
names(normsig_epith_pat_ups) <- patients_now
names(pds_epith_ct) <- patients_now


2.可视化操作

ht_sep_normsig_both <-
  Heatmap(normsig_epith_pat_both[[1]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[1],
          top_annotation = ha_lehman_epith_pat[[1]],
          column_title_gp = gpar(fontsize = 12),
          show_row_names = FALSE,
          name = patients_now[1],
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(normsig_epith_pat_both[[2]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[2],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[2]],
          name = patients_now[2], 
          show_heatmap_legend = FALSE,
          show_row_names = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(normsig_epith_pat_both[[3]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[3],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[3]],
          name = patients_now[3],
          show_heatmap_legend = FALSE,
          show_row_names = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(normsig_epith_pat_both[[4]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[4],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[4]],
          name = patients_now[4],
          show_heatmap_legend = FALSE,
          show_row_names = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(normsig_epith_pat_both[[5]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[5],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[5]],
          name = patients_now[5],
          show_heatmap_legend = FALSE,
          show_row_names = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(normsig_epith_pat_both[[6]],
          col = colorRamp2(c(-0.7, -0.2, 0.7), c("blue","white", "red")),
          cluster_rows = FALSE,
          row_names_side = "right",
          column_title = patients_now[6],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[6]],
          name = patients_now[6], 
          show_column_names = FALSE,
          heatmap_legend_param = list(title = "Expression",title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9)))
#pdf("fig3b.pdf", onefile = FALSE, width = 20)
print(draw(ht_sep_normsig_both, annotation_legend_side = "right"))
#dev.off()


图片展示

Fig3c

代码重复

1.操作准备流程

#正常签名的点图
all.equal(HSMM_allepith_clustering$Cluster, clustering_allepith)
all.equal(colnames(normsig_avg_both_epithelial), colnames(HSMM_allepith_clustering))

clust_avg_normsig_both <- matrix(NA, nrow = length(unique(HSMM_allepith_clustering$Cluster)), ncol = nrow(normsig_avg_both_epithelial))
rownames(clust_avg_normsig_both) <- paste("clust", c(1:length(unique(HSMM_allepith_clustering$Cluster))), sep = "")
colnames(clust_avg_normsig_both) <- rownames(normsig_avg_both_epithelial)
for (c in 1:length(unique(HSMM_allepith_clustering$Cluster))) {
  clust_avg_normsig_both[c,] <- apply(normsig_avg_both_epithelial[,which(HSMM_allepith_clustering$Cluster == c)], 1, mean)
}

clust_avg_normsig_both <- as.data.frame(clust_avg_normsig_both)
clust_avg_normsig_both$Cluster <- rownames(clust_avg_normsig_both)
clust_avg_normsig_melt <- melt(clust_avg_normsig_both, "Cluster")


2.可视化

#pdf("fig3c.pdf", width = 6.5)
colnames(clust_avg_normsig_melt)<-c("Cluster","Signature","value")
ggplot(clust_avg_normsig_melt, aes(Cluster, value, fill = Signature, color = Signature, shape =Signature)) + 
  geom_point(size = 3, stroke = 1) +
  scale_shape_discrete(solid = T) + 
  ylab("Average expression of signature in cluster") +
  xlab("Cluster") +
  ylim(c(-0.35, 0.5))+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
        panel.background = element_blank(),axis.line=element_line(colour = "black"))#消除背景网格线
#dev.off()


图片展示

Fig3d

代码重复

1.操作准备流程

lehman_long <- read.table("Lehman_signature.txt", sep = "\t", header = TRUE, stringsAsFactors = FALSE)
for (i in 0:5) {
  
  gene <- "gene"
  regulation <- "regulation"
  no_samples <- "no_samples"
  signature <- "signature"
  
  if (i == 0) {
    lehman <- lehman_long[, 1:4]
    lehman <- lehman[-which(lehman$signature == ""),]
  }
  
  if (i > 0) {
    gene <- paste("gene", i, sep = ".")
    regulation <- paste("regulation", i, sep = ".")
    no_samples <- paste("no_samples", i, sep = ".")
    signature <- paste("signature", i, sep = ".")
    
    mat_to_bind <- lehman_long[, c(gene, regulation, no_samples, signature)]
    colnames(mat_to_bind) <- c("gene", "regulation", "no_samples", "signature")
    if (length(which(is.na(mat_to_bind$no_samples))) > 0 )
      mat_to_bind <- mat_to_bind[-which(mat_to_bind$signature == ""),]
    lehman <- rbind(lehman, mat_to_bind)
  }
}

lehman <- tbl_df(lehman) %>%
  group_by(signature)
lehman <- lehman[which(!is.na(match(lehman$gene, rownames(mat_ct)))),]

lehman_signatures <- unique(lehman$signature)

lehman_avg_exps <- apply(mat_ct, 2, function(x){
  
  mns <- matrix(NA, nrow = length(lehman_signatures), ncol = 2)
  rownames(mns) <- lehman_signatures
  for (s in 1:length(lehman_signatures)) {
    sign <- lehman_signatures[s] 
    lehman_here <- lehman %>%
      dplyr::filter(signature == sign)
    lehman_here_up <- lehman_here %>%
      dplyr::filter(regulation == "UP")
    lehman_here_down <- lehman_here %>%
      dplyr::filter(regulation == "DOWN")
    
    #表达矩阵中的基因指数
    idx_genes_up <- match(lehman_here_up$gene, rownames(mat_ct)) 
    idx_genes_down <- match(lehman_here_down$gene, rownames(mat_ct))
    
    mns[s,] <- c(mean(x[idx_genes_up]), mean(x[idx_genes_down]))
  }
  return(mns)
})
all.equal(colnames(lehman_avg_exps), rownames(pd_ct))
lehman_avg_exprs_epithelial <- lehman_avg_exps[,which(pd_ct$cell_types_cl_all == "epithelial")]

lehman_avg_ups <- lehman_avg_exps[c(1:6), ]
rownames(lehman_avg_ups) <- lehman_signatures
all.equal(colnames(lehman_avg_ups), rownames(pd_ct))
lehman_avg_ups_epithelial <- lehman_avg_ups[,which(pd_ct$cell_types_cl_all == "epithelial")]

lehman_avg_downs <- lehman_avg_exps[c(7:12),]
rownames(lehman_avg_downs) <- lehman_signatures
all.equal(colnames(lehman_avg_downs), rownames(pd_ct))
lehman_avg_downs_epithelial <- lehman_avg_downs[,which(pd_ct$cell_types_cl_all == "epithelial")]

lehman_avg_both <- lehman_avg_ups - lehman_avg_downs
all.equal(colnames(lehman_avg_both), rownames(pd_ct))
lehman_avg_both_epithelial <- lehman_avg_both[,which(pd_ct$cell_types_cl_all == "epithelial")]

assignments_lehman_both <- apply(lehman_avg_both, 2, function(x){rownames(lehman_avg_both)[which.max(x)]})
assignments_lehman_both_epithelial <- assignments_lehman_both[which(pd_ct$cell_types_cl_all == "epithelial")]

#通过去除免疫调节和间充质干细胞样签名来更新莱曼签名
lehman_avg_both_epithelial_new <- lehman_avg_both_epithelial[-which(rownames(lehman_avg_both_epithelial) %in% c("immunomodulatory", "mesenchymal_stem_like")),]
assignments_lehman_both_epithelial_new <- apply(lehman_avg_both_epithelial_new, 2, function(x){rownames(lehman_avg_both_epithelial_new)[which.max(x)]})

#每个病人莱曼蛋白表达的热图
pd_ct_epith <- pd_ct[which(pd_ct$cell_types_cl_all == "epithelial"),]
lehmans_epith_pat_both <- list()
lehmans_epith_pat_ups <- list()
pds_epith_ct <- list()
for (i in 1:length(patients_now)) {
  
  lehmans_epith_pat_both[[i]] <- lehman_avg_both_epithelial[,which(pd_ct_epith$patient == patients_now[i])]
  lehmans_epith_pat_ups[[i]] <- lehman_avg_ups_epithelial[,which(pd_ct_epith$patient == patients_now[i])]
  pds_epith_ct[[i]] <- pds_ct[[i]][which(pds_ct[[i]]$cell_types_cl_all == "epithelial"),]
  
}
names(lehmans_epith_pat_both) <- patients_now
names(lehmans_epith_pat_ups) <- patients_now
names(pds_epith_ct) <- patients_now

#每个病人的莱曼表达量
lehmans_epith_pat_both_new <- list()
for (i in 1:length(patients_now)) {
  lehmans_epith_pat_both_new[[i]] <- lehman_avg_both_epithelial_new[,which(pd_ct_epith$patient == patients_now[i])]
}
names(lehmans_epith_pat_both_new) <- patients_now


2.热图注释

#每个病人上皮细胞分离的注释
ha_lehman_epith_pat <- list()
for (i in 1:length(patients_now)) {
  
  if (i == 1)
    ha_lehman_epith_pat[[i]] <- HeatmapAnnotation(df=data.frame(cluster_all = clusterings_sep_allepith[[i]]), 
                                                  col = list(cluster_all = c("1" = "#ee204d", "2" = "#17806d", "3" = "#b2ec5d", "4" = "#cda4de", "5" = "#1974d2")),
                                                  annotation_name_side = "left", annotation_name_gp = gpar(fontsize = 12),
                                                  annotation_legend_param = list(list(title_position = "topcenter", title = "cluster")),
                                                  show_annotation_name = FALSE,
                                                  gap = unit(c(2), "mm"),
                                                  show_legend = FALSE)
  
  if (i > 1 && i != 5 )
    ha_lehman_epith_pat[[i]] <- HeatmapAnnotation(df=data.frame(cluster_all = clusterings_sep_allepith[[i]]), 
                                                  col = list(cluster_all = c("1" = "#ee204d", "2" = "#17806d", "3" = "#b2ec5d", "4" = "#cda4de", "5" = "#1974d2")),
                                                  annotation_name_side = "left", annotation_name_gp = gpar(fontsize = 12),
                                                  annotation_legend_param = list(list(title_position = "topcenter", title = "cluster")),
                                                  show_annotation_name = FALSE,
                                                  gap = unit(c(2), "mm"),
                                                  show_legend = FALSE)
  
  if (i == 5)
    ha_lehman_epith_pat[[i]] <- HeatmapAnnotation(df=data.frame(cluster_all = clusterings_sep_allepith[[i]]), 
                                                  col = list(cluster_all = c("1" = "#ee204d", "2" = "#17806d", "3" = "#b2ec5d", "4" = "#cda4de", "5" = "#1974d2")),
                                                  annotation_name_side = "right", annotation_name_gp = gpar(fontsize = 12),
                                                  annotation_legend_param = list(list(title_position = "topcenter",title = "cluster")),
                                                  show_annotation_name = FALSE,
                                                  gap = unit(c(2), "mm"),
                                                  show_legend = TRUE)
}
all.equal(names(lehmans_epith_pat_both), patients_now)


#加上基础签名
lehmans_epith_pat_both_wbasal_new <- lehmans_epith_pat_both_new
for (i in 1:length(patients_now)) {
  lehmans_epith_pat_both_wbasal_new[[i]] <- rbind(lehmans_epith_pat_both_new[[i]], pData(HSMM_allepith_clustering)$basal_PNAS_avg_exprs[which(HSMM_allepith_clustering$patient == patients_now[i])])
  rownames(lehmans_epith_pat_both_wbasal_new[[i]])[5] <- "intrinsic_basal"
}


3.可视化

#热图可视化
ht_sep_lehmans_both_wbasal_new <-
  Heatmap(lehmans_epith_pat_both_wbasal_new[[1]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[1],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[1]],
          name = patients_now[1], 
          show_row_names = FALSE,
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(lehmans_epith_pat_both_wbasal_new[[2]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[2],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[2]],
          name = patients_now[2], 
          show_row_names = FALSE,
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(lehmans_epith_pat_both_wbasal_new[[3]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[3],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[3]],
          name = patients_now[3], 
          show_row_names = FALSE,
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(lehmans_epith_pat_both_wbasal_new[[4]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[4],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[4]],
          name = patients_now[4], 
          show_row_names = FALSE,
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(lehmans_epith_pat_both_wbasal_new[[5]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          show_column_names = FALSE,
          column_title = patients_now[5],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[5]],
          name = patients_now[5], 
          show_row_names = FALSE,
          show_heatmap_legend = FALSE,
          heatmap_legend_param = list(title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9))) +
  Heatmap(lehmans_epith_pat_both_wbasal_new[[6]],
          col = colorRamp2(c(-0.7, 0, 1), c("blue","white", "red")),
          cluster_rows = FALSE,
          row_names_side = "right",
          column_title = patients_now[6],
          column_title_gp = gpar(fontsize = 12),
          top_annotation = ha_lehman_epith_pat[[6]],
          name = patients_now[6], 
          show_column_names = FALSE,
          heatmap_legend_param = list(title = "Expression",title_gp = gpar(fontsize = 9), labels_gp = gpar(fontsize = 9)))
          
#pdf("fig3d.pdf", onefile = FALSE, width = 20)
print(draw(ht_sep_lehmans_both_wbasal_new, annotation_legend_side = "right"))
#dev.off()


图片展示

Fig3e

代码重复

1.操作准备流程

#新莱曼标志物的点图
clust_avg_lehman_both_new <- matrix(NA, nrow = length(unique(HSMM_allepith_clustering$Cluster)), ncol = nrow(lehman_avg_both_epithelial_new))
rownames(clust_avg_lehman_both_new) <- paste("clust", c(1:length(unique(HSMM_allepith_clustering$Cluster))), sep = "")
colnames(clust_avg_lehman_both_new) <- rownames(lehman_avg_both_epithelial_new)
for (c in 1:length(unique(HSMM_allepith_clustering$Cluster))) {
  clust_avg_lehman_both_new[c,] <- apply(lehman_avg_both_epithelial_new[,which(HSMM_allepith_clustering$Cluster == c)], 1, mean)
}

clust_avg_lehman_both_new <- as.data.frame(clust_avg_lehman_both_new)
clust_avg_lehman_both_new$Cluster <- rownames(clust_avg_lehman_both_new)
clust_avg_lehman_melt_new <- melt(clust_avg_lehman_both_new, "Cluster")


2.可视化

#pdf("fig3e.pdf", width = 7)
colnames(clust_avg_lehman_melt_new)<-c("Cluster","Signature","value")
ggplot(clust_avg_lehman_melt_new, aes(Cluster, value, fill = Signature, color = Signature, shape =Signature)) + 
  geom_point(size = 3, stroke = 1) +
  scale_shape_discrete(solid = T) +
  ylab("Average expression of signature in cluster") +
  xlab("Cluster") +
  ylim(c(-0.35, 0.5))+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
        panel.background = element_blank(),axis.line=element_line(colour = "black"))#消除背景网格线
#dev.off()


图片展示

Fig3f

代码重复

1.操作准备流程

#每个病人和每个簇正常特征图
all.equal(colnames(HSMM_allepith_clustering), names(assignments_normsig_both_epithelial))
pData(HSMM_allepith_clustering)$assignments_normsig_both <- assignments_normsig_both_epithelial
pData(HSMM_allepith_clustering)$assignments_normsig_ups <- assignments_normsig_ups_epithelial


2.可视化

#pdf("fig3f.pdf", width = 10)
plot_cell_clusters(HSMM_allepith_clustering, 2, 1, color = "assignments_normsig_both", cell_size = 2) + facet_wrap(~patient)
#dev.off()


图片展示

Fig3g

代码重复

1.操作准备流程

#每个病人和每个集群的莱曼绘图
all.equal(colnames(HSMM_allepith_clustering), names(assignments_lehman_both_epithelial_new))
pData(HSMM_allepith_clustering)$assignments_lehman_both_new <- assignments_lehman_both_epithelial_new


2.可视化

#pdf("fig3g.pdf", width = 10)
plot_cell_clusters(HSMM_allepith_clustering, 1, 2, color = "assignments_lehman_both_new", cell_size = 2) + facet_wrap(~patient)
#dev.off()


图片展示