偷偷问一下，关注了吗？
内容获取
1、购买打包合集（《KS科研分享与服务》付费内容打包集合），价格感人，可以加入微信VIP群（答疑交流群，甚至有小伙伴觉得群比代码更好），可以获取建号以来所有内容，群成员专享视频教程，提前更新，其他更多福利！
2、《KS科研分享与服务》公众号有QQ群，进入门槛是20元（完全是为了防止白嫖党，请理解），请考虑清楚。群里有免费推文的注释代码和示例数据（终身拥有），没有付费内容，群成员福利是购买单个付费内容半价！
需要者详情请联系作者（非需要者勿扰，处理太费时间）：
devtools::install_github("jinming-cheng/scTernary")library(scTernary)
#load datadata_exp_mat <- example_seu@assays$RNA@counts #一个seurat obj，获取conuts矩阵data_exp_mat <- as.matrix(data_exp_mat)dim(data_exp_mat)# [1] 13750 80#需要准备一个signature dataload("D:/KS项目/公众号文章/三元图绘制-单细胞中的应用/data/anno_signature_genes_mouse.rda")head(anno_signature_genes_mouse)# GeneID Symbol Chr gene_type# 497097 497097 Xkr4 1 Basal# 329093 329093 Cpa6 1 Basal# 320492 320492 A830018L16Rik 1 Basal# 240725 240725 Sulf1 1 Basal# 14048 14048 Eya1 1 Basal# 226866 226866 Sbspon 1 Basal#Prepare data for ternary plot.#准备作图文件data_for_ternary <- generate_data_for_ternary(data_exp_mat = data_exp_mat,anno_signature_genes = anno_signature_genes_mouse,gene_name_col = "Symbol",gene_type_col = "gene_type",weight_by_gene_count = TRUE,cutoff_exp = 0,prior_count = 1)
如果想知道data_for_ternary具体的方式，可以查看原函数，还是很好理解的：简单来说就是，统计每个cell表达某种状态例如Basal特征基因的个数，最后如果需要，可以对数据做一个权重计算，也就是每个cell统计的表达某种状态例如Basal特征基因的个数除以提供的Basal特征基因总数即可。最后形成文件是3列n行的数据，列是三种标量，行是cell，也就是三元图中的每个点。
generate_data_for_ternary <- function(data_exp_mat = NULL,anno_signature_genes = NULL,gene_name_col = "GeneID",gene_type_col = "gene_type",weight_by_gene_count = TRUE,print_gene_num = FALSE,cutoff_exp = 0,prior_count = 2){name_signatures <- levels( factor(anno_signature_genes[,gene_type_col]) )# prior count for signaturesif(length(prior_count)==1){prior_count <- rep(prior_count, length(name_signatures))names(prior_count) <- name_signatures}else if(is.null(names(prior_count) ) ){names(prior_count) <- name_signatures}data_for_ternary <- matrix(0L,nrow = ncol(data_exp_mat),ncol = length(name_signatures))rownames(data_for_ternary) <- colnames(data_exp_mat)colnames(data_for_ternary) <- c(name_signatures)for (i in name_signatures ) {# get geneID or symbol of one signature (Basal, LP or ML)genes_of_one_signature <- subset(anno_signature_genes,get(gene_type_col) == i)[,gene_name_col]# common genes between genes of one signature and genes in expression matrixgenes_of_one_signature <- intersect(genes_of_one_signature, rownames(data_exp_mat) )assign(i, genes_of_one_signature)# cutoff_exp can be one single value or a vector with length of ncol(data_exp_mat)data_for_ternary[, i] <- rowSums(t(data_exp_mat[get(i),]) > cutoff_exp)# add a prior countdata_for_ternary[, i] <- data_for_ternary[, i] + prior_count[i]# whether divide expressed gene count by common gene count usedif (weight_by_gene_count) {if(print_gene_num) {print( paste0(i,": " ,length(genes_of_one_signature) ))}data_for_ternary[, i] <- data_for_ternary[, i] / length(genes_of_one_signature)}}data_for_ternary}
作图：
#plotdata_for_ternary <- cbind(data_for_ternary,example_seu@meta.data)scTernary::vcdTernaryPlot(data_for_ternary,order_colnames=c(2,3,1),point_size = 0.5,group = data_for_ternary$seurat_clusters,show_legend = TRUE,scale_legend = 0.8,legend_position = c(0.2,0.5),legend_vertical_space = 1,legend_text_size = 1)
我们再演示一下bulk转录组数据，双组数据的展示还是挺多方式的，火山图等等。想要三组一起展示，那么刚好三元图可以应用，我们这里以一个包含三组的bulk数据演示，可以标注各自显著差异基因，或展示某些关注的基因，以及某些特征基因。这里我们演示ggtern包做三元图，无它，就是好修饰图而已！
这里我们演示三组的bulk数据，三元图的顶点是三个分组，展示每组基因的平均值。可以突出标识差异基因或者特异性基因！
#bulk 转录组数据展示例子install.packages("ggtern")library(ggtern)library(ggrastr)library(ggplot2)#load exp dataBulk_FPKM <- read.csv('Bulk_FPKM.csv', header = T, row.names = 1)Bulk_FPKM <- Bulk_FPKM[rowSums(Bulk_FPKM) > 0.1, ]#差异基因分析# colnames(Bulk_FPKM)# meta <- data.frame(E1 = c("E1.1","E1.2","E1.3"),E18 = c("E18.1","E18.2","E18.3"),E30=c("E30.1","E30.2","E30.3"))# deg <- KS_bulkRNA_MultiGroup_DEGs(exprSet = Bulk_FPKM,meta = meta,methods = "limma",separator=".")#计算average expavg_exp <- data.frame(E1 = matrixStats::rowMeans2(as.matrix(Bulk_FPKM[ 1:3])),E18 = matrixStats::rowMeans2(as.matrix(Bulk_FPKM[ 4:6])),E30 = matrixStats::rowMeans2(as.matrix(Bulk_FPKM[ 7:9])))avg_exp$gene <- rownames(avg_exp)avg_exp$average <- rowMeans(avg_exp[,1:3])avg_exp$gene_type <- 'Other'avg_exp$gene_type <- ifelse(avg_exp$gene %in% c("MEPCE","OR2S2","ANKZF1","LRRC61","SOHLH2"),"down",ifelse(avg_exp$gene %in% c("GLO1","KIF18A","SNAP29","FHL3","HACD2","CFH"),"up",avg_exp$gene_type))#plotggtern(data=avg_exp,aes(x=E1,y=E18,z=E30))+geom_point_rast(data = avg_exp,aes(size = average), color = "grey80",alpha = 0.8, show.legend = FALSE) +geom_point(data = avg_exp[avg_exp$gene_type == 'up',],size = 3,color = '#ED645A',show.legend = F)+geom_point(data = avg_exp[avg_exp$gene_type == 'down',],size = 3,color = "#4895ef",show.legend = F)+geom_text(data = avg_exp[avg_exp$gene_type == 'up',],aes(label=gene),color = 'black',size = 3, fontface = 'italic')
其他形式请自行探索！觉得我们分享有些用的，点个赞再走呗！
关注我们获取精彩内容：
关注不迷路：扫描下面二维码关注公众号！
B站视频号链接：https://space.bilibili.com/471040659?spm_id_from=333.1007.0.0
关注 KS科研分享与服务，
认清正版优质内容和服务！
优质内容持续输出，物超所值！
合作联系：ks_account@163.com
