scRNA|R版CytoTRACE v2从0开始完成单细胞分化潜能预测-腾讯云开发者社区-腾讯云 (tencent.com)

library(CytoTRACE2)
expl <- as.matrix(sce@assays$RNA@counts)
expl <- expl[apply(expl > 0, 1, sum) >= 5, ]
cytotrace2_result_sce <- cytotrace2(sce[rownames(expl), ], 
                                    is_seurat = TRUE, 
                                    slot_type = "counts", 
                                    species = 'mouse',
                                    ncores = 60, 
                                    seed = 1234)
annotation <- data.frame(phenotype = sce@meta.data$seurat_clusters) %>% 
  set_rownames(., colnames(sce))
plots <- plotData(cytotrace2_result = cytotrace2_result_sce, 
                  annotation = annotation, 
                  is_seurat = TRUE)
# 绘制CytoTRACE2_Potency的umap图
p1 <- plots$CytoTRACE2_UMAP
# 绘制CytoTRACE2_Potency的umap图
p2 <- plots$CytoTRACE2_Potency_UMAP
# 绘制CytoTRACE2_Relative的umap图 ，v1 
p3 <- plots$CytoTRACE2_Relative_UMAP 
# 绘制各细胞类型CytoTRACE2_Score的箱线图
p4 <- plots$CytoTRACE2_Boxplot_byPheno
pdf("CytoTRACE2_UMAP.pdf", width = 16, height = 4)
(p1+p2+p3+p4) + patchwork::plot_layout(ncol = 4)
dev.off()
pdf("CytoTRACE2_Boxplot_byPheno.pdf", width = 8, height = 5.5)
p4 + theme(text = element_text(size = 12))
dev.off()
saveRDS(cytotrace2_result_sce, "cytotrace2_result_sce.Rds")

pdf("CytoTRACE2_Relative.pdf", width = 8, height = 8)
FeaturePlot(cytotrace2_result_sce, "CytoTRACE2_Relative",pt.size = 1.5) + 
  scale_colour_gradientn(colours = 
                           (c("#9E0142", "#F46D43", "#FEE08B", "#E6F598", 
                              "#66C2A5", "#5E4FA2")), 
                         na.value = "transparent", 
                         limits = c(0, 1), 
                         breaks = seq(0, 1, by = 0.2), 
                         labels = c("0.0 (More diff.)", 
                                    "0.2", "0.4", "0.6", "0.8", "1.0 (Less diff.)"), 
                         name = "Relative\norder \n", 
                         guide = guide_colorbar(frame.colour = "black", 
                                                ticks.colour = "black")) + 
  ggtitle("CytoTRACE 2") + 
  xlab("UMAP1") + ylab("UMAP2") + 
  theme(legend.text = element_text(size = 12), 
        legend.title = element_text(size = 12), 
        axis.text = element_text(size = 12), 
        axis.title = element_text(size = 12), 
        plot.title = element_text(size = 14, 
                                  face = "bold", hjust = 0.5, 
                                  margin = margin(b = 0))) + 
  theme(aspect.ratio = 1) + tidydr::theme_dr()
dev.off()

library(ggpubr)
p1 <- ggboxplot(cytotrace2_result_sce@meta.data, x="seurat_clusters", y="CytoTRACE2_Score", width = 0.6, 
                color = "black",#轮廓颜色
                fill="seurat_clusters",#填充  
                # palette = "npg",  
                xlab = F, #不显示x轴的标签
                bxp.errorbar=T, #显示误差条
                bxp.errorbar.width=0.5, #误差条大小
                size=1, #箱型图边线的粗细
                outlier.shape=NA, #不显示outlier
                legend = "right") #图例放右边 
# my_comparisons <- list(c("Epi", "un"), c("T", "un"),c("Myeloid", "un"))
pdf("CytoTRACE2_Score_boxplot.pdf", width = 8, height = 4.5)
p1 + scale_color_manual(values = colors_set)#+stat_compare_means(comparisons = my_comparisons,method = "wilcox.test")
dev.off()