CIBERSORT免疫浸润的R实现

CIBERSORT免疫浸润的代码实现 (qq.com)

数据直接从xena上下载,命名为TCGA_chol

rm(list=ls())
library(data.table)
#help(fread)
TGCA_CHOL<-fread("TCGA_chol",data.table=F)
rownames(TGCA_CHOL)<-TGCA_CHOL[,1]
TGCA_CHOL<-TGCA_CHOL[,-1]
exp<-TGCA_CHOL

exp<-2^TGCA_CHOL-1
head(exp)


按照上面的教程走,但是走了一点弯路,事实上这些如果是从xena上下载之后,其实不需要转换为TPM的,直接使用FPKM就行,但是还是保存下来,因为有些代码还是废了不少脑筋去自己写
gencode.v22.annotation.gtf.gz


# if(T){
#   library(rtracklayer)
#   
#   gtf = fread("gencode.v25.annotation.gff3.gz")
#   class(gtf)
#   gtf = as.data.frame(gtf);dim(gtf)
#   table(gtf$type)
#   colnames(gtf)<-c("chrom","speices","type","start","end","strand1","strand2","strand3","gene_name")
#   exon = gtf[gtf$type=="exon",
#            c("start","end","gene_name")]
#   s=as.data.frame(strsplit(exon$gene_name,";"),fill=T)
#   n=split(exon,exon$gene_name)
#   n2<-as.data.frame(n)
#   head(n2)
#   gle = lapply(split(exon,exon$gene_name),function(x){
#     #exon$name=strsplit(strsplit(exon$gene_name,";")[[1]][7],"=")[[1]][2]
#     tmp=apply(x,1,function(y){
#         y[1]:y[2]
#     })
#     length(unique(unlist(tmp)))
#   })
#   gle=data.frame(gene_name=names(gle),
#                length=as.numeric(gle))
#   head(gle)
#   library(tidyverse)
#   gle %>% separate(gene_name,c("key","value"),"gene_name=")%>%separate(value,c("gene","b"),";")->gle2
#   gle3<-gle2[,c("gene","length")]
#   head(gle3)
#   save(gle3,file = "v25_gle.Rdata")
# }

# 
# sub=function(x){
#   strsplit(strsplit(x,";")[[1]][7],"=")[[1]][2]
# }
# bb<-unlist(lapply(exon$gene_name, sub))
# bb2<-length(unique(unlist(bb)))
# bb2
#le = gle[match(rownames(exp),gle3$gene_name),"length"]

# if(T){
#   #head(gtf)
#   library(rtracklayer)
#   gtf = rtracklayer::import("gencode.v22.annotation.gtf.gz")
#   class(gtf)
#   gtf = as.data.frame(gtf);dim(gtf)
#   table(gtf$type)
#   exon = gtf[gtf$type=="exon",
#            c("start","end","gene_name")]
#   gle = lapply(split(exon,exon$gene_name),function(x){
#     tmp=apply(x,1,function(y){
#         y[1]:y[2]
#     })
#     length(unique(unlist(tmp)))
#   })
#   gle=data.frame(gene_name=names(gle),
#                length=as.numeric(gle))
#   save(gle,file = "v22_gle.Rdata")
# }
# load("v22_gle.Rdata")
# head(gle)
# ```

```{r}
# le = gle[match(rownames(exp),gle$gene_name),"length"]
# head(le)
# #这个函数是现成的。
# countToTpm <- function(counts, effLen)
# {
#     rate <- log(counts) - log(effLen)
#     denom <- log(sum(exp(rate)))
#     exp(rate - denom + log(1e6))
# }
# tpms <- apply(exp,2,countToTpm,le)
# tpms[1:3,1:3]

直接从这里开始,上面的可以不要管

source("CIBERSORT.R")
exp2<-as.data.frame(exp)
exp2<-data.frame(gene=rownames(exp2),exp2)
head(exp2)
write.table(exp2,file = "exp.txt",row.names = F,quote = F,sep = "\t")
if(T){
  TME.results = CIBERSORT("LM22.txt", 
                          "exp.txt" , 
                          perm = 1000, 
                          QN = T)
  save(TME.results,file = "ciber_CHOL.Rdata")
}
load("ciber_CHOL.Rdata")
TME.results[1:4,1:4]
re <- TME.results[,-(23:25)]
library(pheatmap)
k <- apply(re,2,function(x) {sum(x == 0) < nrow(TME.results)/2})
table(k)
## k
## FALSE  TRUE 
##     8    14
re2 <- as.data.frame(t(re[,k]))

an = data.frame(group = Group,
                row.names = colnames(exp))
pheatmap(re2,scale = "row",
         show_colnames = F,
         #annotation_col = an,
         color = colorRampPalette(c("navy", "white", "firebrick3"))(50))
library(tidyverse)
library(RColorBrewer)
mypalette <- colorRampPalette(brewer.pal(8,"Set1"))

dat <- re %>% as.data.frame() %>%
  rownames_to_column("Sample") %>% 
  gather(key = Cell_type,value = Proportion,-Sample)

ggplot(dat,aes(Sample,Proportion,fill = Cell_type)) + 
  geom_bar(stat = "identity") +
  labs(fill = "Cell Type",x = "",y = "Estiamted Proportion") + 
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        legend.position = "bottom") + 
  scale_y_continuous(expand = c(0.01,0)) +
  scale_fill_manual(values = mypalette(22))
ggplot(dat,aes(Cell_type,Proportion,fill = Cell_type)) + 
  geom_boxplot(outlier.shape = 21,color = "black") + 
  theme_bw() + 
  labs(x = "Cell Type", y = "Estimated Proportion") +
    theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        legend.position = "bottom") + 
  scale_fill_manual(values = mypalette(22))
a = dat %>% 
  group_by(Cell_type) %>% 
  summarise(m = median(Proportion)) %>% 
  arrange(desc(m)) %>% 
  pull(Cell_type)

dat$Cell_type = factor(dat$Cell_type,levels = a)

ggplot(dat,aes(Cell_type,Proportion,fill = Cell_type)) + 
  geom_boxplot(outlier.shape = 21,color = "black") + 
  theme_bw() + 
  labs(x = "Cell Type", y = "Estimated Proportion") +
    theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        legend.position = "bottom") + 
  scale_fill_manual(values = mypalette(22))
dat$Group = ifelse(as.numeric(str_sub(dat$Sample,14,15))<10,"tumor","normal")
library(ggpubr)
ggplot(dat,aes(Cell_type,Proportion,fill = Group)) + 
  geom_boxplot(outlier.shape = 21,color = "black") + 
  theme_bw() + 
  labs(x = "Cell Type", y = "Estimated Proportion") +
  theme(legend.position = "top") + 
  theme(axis.text.x = element_text(angle=80,vjust = 0.5))+
  scale_fill_manual(values = mypalette(22)[c(6,1)])+ stat_compare_means(aes(group = Group,label = ..p.signif..),method = "kruskal.test")
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,684评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 87,143评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 151,214评论 0 337
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,788评论 1 277
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,796评论 5 368
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,665评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 38,027评论 3 399
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,679评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 41,346评论 1 299
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,664评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,766评论 1 331
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,412评论 4 321
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 39,015评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,974评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,203评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 45,073评论 2 350
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,501评论 2 343

推荐阅读更多精彩内容