TCGA_联合GTEx分析2_查看批次效应

在 TCGA_联合GTEx分析1_得到表达矩阵.tpm_老实人谢耳朵的博客-CSDN博客 中,获取了TCGA和GTEx中样本的表达矩阵数据,数据格式均为tpm。本文对二者进行合并后,通过PCA分析、绘制内参箱线图等方法,查看是否存在批次效应。

关于批次效应的说明,可参看 批次效应(Batch effect)解读

一、数据准备

1 合并后的表达矩阵 

exp_tcga.tpm <- read.csv(file = "exp_tcga.tpm.csv", header=T, row.names=1,check.names=FALSE)
exp_gtex.tpm <- read.csv(file = "exp_gtex.tpm.csv", header=T, row.names=1,check.names=FALSE)

t_index=intersect(rownames(exp_gtex.tpm),rownames(exp_tcga.tpm))
exp_m = cbind(exp_tcga.tpm[t_index,],exp_gtex.tpm[t_index,])
rm(exp_tcga.tpm,exp_gtex.tpm)

View(exp_tcga.tpm) 

包括500个TP,52个NT

View(exp_gtex.tpm)

包括100个NT

View(exp_m)

2 分组信息

group = ifelse(colnames(exp_m[,1:552]) %in% t_dataSmTP,'tcgaTP','tcgaNT')
group = c(group,rep('gtexNT',ncol(exp_m)-length(group)))
barcode=colnames(exp_m)

design = data.frame('Barcode'=barcode,'Group'=group)

View(design)

 

二、 主成分分析(Principal Component Analysis)查看批次效应

R语言如何绘制PCA图(四)_心有灵犀啦的博客-CSDN博客_r语言绘制pca图

PCA分析是查看批次效应的最佳方式,如果样本明显按照批次聚类,说明存在批次效应。 

library(ggplot2)
library(ggbiplot)

1 数据准备——转置矩阵

exp_m_t=as.data.frame(t(exp_m))

主成分分析,绘制的总是“行变量”的聚类图,因为想看的是barcode的聚类而不是基因的聚类,所以进行转置,使barcode转成行变量。

View(exp_m_t)

 2 PCA分析

pca_result <- prcomp(exp_m_t,scale=T)  # 一个逻辑值,指示在进行分析之前是否应该将变量缩放到具有单位方差

ggbiplot(pca_result, 
         var.axes=F,            # 是否为变量画箭头
         obs.scale = 1,         # 横纵比例 
         groups = design$Group, # 添加分组信息,将按指定的分组信息上色
         ellipse = T,           # 是否围绕分组画椭圆
         circle = F) +
ggtitle('PCAplot_tcga&gtex') +
xlim(-100, 200) + ylim(-200, 100) #限制横纵轴范围

PCA图中,tcgaNT 和 gtexNT 明显分为两个亚群,表明存在较强的批次效应。

 

三、 内参表达箱线图查看批次效应

library(ggplot2)
library(reshape2)

1 数据准备——构造 exp_Reshape 用于绘制箱线图

exp_R = melt(as.matrix(log2(exp_m+1)))     #melt()的输入必须为matrix,得到的exp_R为dataframe
colnames(exp_R) = c('Gene','Barcode','Value')
exp_R$Group = rep(group,each=nrow(exp_m))

View(exp_R)

 

2 ggplot2绘图

gene='All_gene'

p_allgene = ggplot(exp_R,aes(x=Group, y=Value,fill=Group)) + #fill进行颜色填充
  geom_boxplot() +
  stat_summary(fun="mean",geom="point",shape=23, size=4,fill="white") + #添加均值点
  ggtitle(paste0('Expression of ',gene)) +
  xlab('Group') + ylab('log2(tpm+1)') + #x轴y轴标签
  ylim(0, 5)
p_allgene

 所有样本 All_genes 表达量的平均值

 

 

gene='ACTB'

p_actb = ggplot(exp_R[exp_R$Gene==gene,],aes(x=Group, y=Value,fill=Group)) + #fill进行颜色填充
  geom_boxplot() +
  stat_summary(fun="mean",geom="point",shape=23, size=4,fill="white") + #添加均值点
  ggtitle(paste0('Expression of ',gene)) +
  xlab('Group') + ylab('log2(tpm+1)') + #x轴y轴标签
  ylim(10, 15)
p_actb

 所有样本 ACTB 表达量的平均值  

 

 

gene='RPLP0'

p_rplp0 = ggplot(exp_R[exp_R$Gene==gene,],aes(x=Group, y=Value,fill=Group)) + #fill进行颜色填充
  geom_boxplot() +
  stat_summary(fun="mean",geom="point",shape=23, size=4,fill="white") + #添加均值点
  ggtitle(paste0('Expression of ',gene)) +
  xlab('Group') + ylab('log2(tpm+1)') + #x轴y轴标签
  ylim(7, 12)
p_rplp0

 所有样本 RPLP0 表达量的平均值   

 

从内参表达箱线图中,不太容易看出批次效应。 All_genes图中批次效应明显一些。

 

  • 6
    点赞
  • 48
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 16
    评论
这里提供一份基于R语言的TCGA联合GTEx数据去除批次效应后的差异分析代码,供您参考: ```R # 安装所需的包 install.packages("edgeR") install.packages("limma") install.packages("ggplot2") install.packages("dplyr") install.packages("tidyr") install.packages("ComBat") # 导入TCGA和GTEx的RNA-seq原始数据并进行质量控制和基因表达量计算 library(edgeR) library(limma) library(ComBat) # 导入TCGA和GTEx的数据,注意文件格式和路径 tcga_data <- read.table("tcga_data.txt", header = T, row.names = 1, sep = "\t") gtex_data <- read.table("gtex_data.txt", header = T, row.names = 1, sep = "\t") # 将TCGA和GTEx的数据合并 all_data <- cbind(tcga_data, gtex_data) # 进行基因表达量计算 all_counts <- apply(all_data, 1, sum) all_tpm <- sweep(all_data, 2, all_counts, FUN = "/") * 10^6 # 进行批次效应去除 batch <- c(rep("TCGA", ncol(tcga_data)), rep("GTEx", ncol(gtex_data))) batch_combat <- ComBat(dat = all_tpm, batch = batch, mod = NULL, par.prior = TRUE, prior.plots = FALSE) # 进行差异分析 counts <- t(batch_combat$dat) group <- c(rep("TCGA", ncol(tcga_data)), rep("GTEx", ncol(gtex_data))) design <- model.matrix(~0+group) colnames(design) <- levels(group) y <- DGEList(counts = counts, group = group) y <- calcNormFactors(y, method = "TMM") y <- estimateDisp(y, design) fit <- glmQLFit(y, design) qlf <- glmQLFTest(fit, coef = 1) # 根据FDR筛选差异表达基因 diff_genes <- topTags(qlf, n = Inf, sort.by = "none")$table diff_genes <- diff_genes[diff_genes$FDR < 0.05,] # 对差异表达基因进行注释和功能分析 library(dplyr) library(tidyr) # 可以根据需要选择不同的基因注释数据库 # 这里以ENSEMBL为例,需要提前下载ENSEMBL注释文件 anno_file <- "Homo_sapiens.GRCh38.98.gtf.gz" gene_anno <- read.table(gzfile(anno_file), header = F, stringsAsFactors = F) gene_anno <- gene_anno[gene_anno$V3 == "gene",] gene_anno$gene_id <- gsub("\"", "", sapply(strsplit(gene_anno$V9, split = ";"), function(x) x[1])) gene_anno$gene_name <- gsub("\"", "", sapply(strsplit(gene_anno$V9, split = ";"), function(x) x[5])) diff_genes_anno <- diff_genes %>% left_join(gene_anno, by = c("GeneID" = "gene_id")) %>% select("GeneID", "logFC", "FDR", "gene_name") # 对差异表达基因进行富集分析 library(clusterProfiler) # 选择需要分析的物种和基因注释数据库 species <- "Homo sapiens" org <- "org.Hs.eg.db" enrich_res <- enrichGO(diff_genes_anno$gene_name, OrgDb = org, keyType = "SYMBOL", ont = "BP", pAdjustMethod = "BH", qvalueCutoff = 0.05, universe = unique(gene_anno$gene_name)) # 将结果可视化展示 library(ggplot2) enrich_res %>% mutate(Term = fct_reorder(Term, -log10(pvalue))) %>% ggplot(aes(x = -log10(pvalue), y = as.factor(Term))) + geom_point(size = 3) + scale_y_discrete(limits = rev(levels(enrich_res$Term))) + labs(x = "-log10(pvalue)", y = "GO Term") + ggtitle("GO Enrichment Analysis of DE Genes") + theme_bw(base_size = 15) ``` 需要注意的是,这段代码中涉及到的数据文件格式和路径需要根据实际情况进行修改。此外,在进行差异分析和富集分析时,需要选择合适的基因注释数据库和分析参数。
评论 16
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

郁柳_Fudan

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值