正文
Analyzing Microarray Data with R
小程序：扫一扫查出行【扫一扫了解最新限行尾号】
复制小程序
1) 熟悉CEL file
从 NCBI GEO (http://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE24460)下载GSE24460. 将得到一个 GSE24460_RAW.tar 文件，解压。产生CEL文件，包含各种信息。
if("affy" %in% rownames(installed.packages()) == FALSE) {source("http://bioconductor.org/biocLite.R");biocLite("affy")}
suppressMessages(library(affy))
ls('package:affy')myData <- ReadAffy(celfile.path="F:/R/bioinformation with R cookbook") #ReadAffy()返回的是一个AffyBatch object(对象)
#myData1 <- ReadAffy(filenames = "F:/R/bioinformation with R cookbook/GSM602658_MCF71.CEL") #读取单个文件
--------如果不是从CEL文件读取，而是有多个独立的临床、实验、表达矩阵等文件，则需根据这些文件构建新的ExpressionSet对象，如下例子：---------------
每一部分组合成 ExpressionSet 对象，都扮演各自的角色。 exprs object 是表达量， phenotypic data 是样本临床信息 ( sex, age, treatment ...), annotated package 提供基本数据操作工具 。
##############################构建ExpressionSet对象(包含临床、实验、表达矩阵等多种信息)###############################
######利用自带数据集演示#######
suppressMessages(library(Biobase))
DIR <- system.file("extdata", package="Biobase")
exprsLoc <- file.path(DIR, "exprsData.txt")
pDataLoc <- file.path(DIR, "pData.txt")exprs <- as.matrix(read.csv(exprsLoc, header = TRUE, sep = "\t", row.names = 1, as.is = TRUE))#读取表达矩阵
class(exprs)
dim(exprs)
pData <- read.table(pDataLoc, row.names = 1, header = TRUE, sep = "\t") #读取临床信息
pData <- new("AnnotatedDataFrame", data = pData) #构建pData对象
exData <- new("MIAME", name="ABCabc", lab="XYZ Lab", contact="abc@xyz", title="", abstract="", url="www.xyz") #编译实验信息，这个不是必须的
exampleSet <- new("ExpressionSet", exprs = exprs, phenoData = pData, experimentData = exData, annotation = "hgu133a2")#利用上边编译好的信息构建ExpressionSet对象
str(exampleSet)
validObject(exampleSet) #检验构建的ExpressionSet对象的有效性
2）Handling the AffyBatch object（了解affBatch对象结构）
myData
str(myData)
pData(myData) #临床信息
phenoData(myData)
exprs(myData) #获取表达矩阵
annotation(myData)# 获取注释信息
probeNames(myData) #获取探针名称
sampleNames(myData) #获取样本名称
3）Checking the quality of data(质控)
与质量相关的问题可能源于：
1、杂交，因为芯片上的荧光不均匀会导致不同的强度分布，非特异性结合或其他生物/技术原因可能在数据中产生背景噪声。
2、不合适的实验设计可能会影响整个数据集。 使用此类数据将导致数据分析期间的错误或不确定的推断。
因此，必须在开始数据分析之前确保数据质量。 这是通过寻找边远数组，数组内的分布，批处理效果等来实现。 有各种分析和诊断图可用于计算这些度量，以解释分析中的阵列数据的质量。
if("arrayQualityMetrics" %in% rownames(installed.packages()) == FALSE) {source("http://bioconductor.org/biocLite.R");biocLite("arrayQualityMetrics")}
suppressMessages(library(arrayQualityMetrics))
if("arrayQualityMetrics" %in% rownames(installed.packages()) == FALSE) {source("http://bioconductor.org/biocLite.R");biocLite("arrayQualityMetrics")}
suppressMessages(library(arrayQualityMetrics))
arrayQualityMetrics(myData, outdir="microarray") #质控
browseURL(file.path("microarray", "index.html"))
MAplot(myData, pairs=TRUE, plot.method="smoothScatter") #MAplot图
plotDensity.AffyBatch(myData) #密度图
boxplot(myData) #箱型图
rnaDeg <- AffyRNAdeg(myData) #查看RNA降解
plotAffyRNAdeg(rnaDeg)
summaryAffyRNAdeg(rnaDeg) #获取RNA降解情况
可以生成网页版报告：
4）Generating artificial expression data（仿真数据）
install.packages("madsim")
library(madsim)
fparams <- data.frame(m1 = 7, m2 = 7, shape2 = 4, lb = 4, ub =
14, pde = 0.02, sym = 0.5)#define your first set of parameters for the simulation process
dparams <- data.frame(lambda1 = 0.13, lambda2 = 2, muminde = 1,
sdde = 0.5) # Define the second set of parameters that consists of the statistical parameters
sdn <- 0.4
rseed <- 50
n <- 35000 #define the number of genes you require in the expression data
myData <- madsim(mdata=NULL, n=35000, ratio=0, fparams, dparams, sdn, rseed)#generate the synthetic data str(myData)
library(limma)
plotMA(myData[[1]], 1) # visualize the data, create an MA plot for any sample, say, #sample 1,
5）Data normalization
标准化用来降低技术影响，产生可比较数据。因为有多种方法可以标准化数据，这里讲vsn, loess, quantile三种方法。
library(vsn)
ls('package:vsn')
myData <- ReadAffy(celfile.path="F:/R/bioinformation with R cookbook") #读取所有CEL文件,返回的是AffyBatch object
#myData.VSN <- normalize.AffyBatch.vsn(myData) #vsn包提示找不到该函数
myData.loess <- normalize.AffyBatch.loess(myData)
boxplot(myData.loess)
myData.quantile <- normalize.AffyBatch.quantiles(myData)
boxplot(myData.quantile)
效果：
6）Overcoming batch effects in expression data
批次效应：是由于对样本不同批次的操作，属于实验样本间的非生物误差。产生原因包括sample preparation or hybridization protocol等，可以在一定程度间消除，但不可避免。因此需要对数据进行一定的预处理。
source("http://bioconductor.org/biocLite.R")
biocLite("bladderbatch")
library(sva) # contains batch removing utilities
library(bladderbatch) # The data to be used
data(bladderdata)
pheno <- pData(bladderEset) #提取表达矩阵 and pheno data
edata <- exprs(bladderEset) #提取样本临床信息
pheno
myData <- bladderEset[,sampleNames(bladderEset)[1:8]] #提取同样本不同批次子集
arrayQualityMetrics(myData, outdir="qc_be") #质控
mod1 <- model.matrix(~as.factor(cancer), data=pData(myData))[,c(1,3)] #model矩阵
batch <- pData(myData)$batch #样本批次信息
edata <- exprs(myData) #表达矩阵
combat_edata <- ComBat(dat=edata, batch=batch, mod=mod1, par.prior=TRUE)#经验贝叶斯方法去merge批次效应
myData2 <- myData
exprs(myData2) <- combat_edata
arrayQualityMetrics(myData2, outdir="qc_nbe")
批次效应如下左图，同一批次的样本进行聚类，移除批次效应之后，见右图
7）样本间关系（An exploratory analysis of data with PCA）
myData <- ReadAffy(celfile.path="F:/R/bioinformation with R cookbook") #读取所有CEL文件,返回的是AffyBatch object
myData.pca <- exprs(myData)
myPca <- prcomp(myData.pca, scale=TRUE) #prcomp函数计算主成分
summary(myPca)
colors <- c("green","cyan","violet","magenta") #给样本设计颜色
pairs(myPca$x, col=colors)
8）差异表达基因(Finding the differentially expressed genes)
library(affy) # Package for affy data handling
library(antiProfilesData) # Package containing input data
library(affyPLM) # Normalization package for eSet
library(limma) # limma analysis package
data(apColonData)
myData <- apColonData[, sampleNames(apColonData)[1:16]]
myData_quantile <- normalize.ExpressionSet.quantiles(myData)
design <- model.matrix(~0 + pData(myData)$Status)
fit <- lmFit(myData_quantile,design)
fit
fitE <- eBayes(fit)
tested <- topTable(fitE, adjust="fdr", sort.by="B", number=Inf)
DE <- x[tested$adj.P.Val<0.01,]
dim[DE]
DE <- x[tested$adj.P.Val< 0.01 & abs(x$logFC) >2,]
9)多组比较，最主要的是设计分组矩阵
library(leukemiasEset)
data(leukemiasEset)
pheno <- pData(leukemiasEset)
myData <- leukemiasEset[, sampleNames(leukemiasEset)[c(1:3, 13:15, 25:27, 49:51)]]
design <- model.matrix(~0 + factor(pData(myData)$LeukemiaType)) #分组矩阵
colnames(design) <- unique(as.character(pData(myData)$LeukemiaType))
design
fit <- lmFit(myData, design)
contrast.matrix <- makeContrasts(NoL- ALL, NoL- AML, NoL- CLL,
levels = design)
fit2 <- contrasts.fit(fit, contrast.matrix)
fit2 <- eBayes(fit2)
tested2 <- topTable(fit2,adjust="fdr",sort.by="B",number=Inf,
coef=1)
DE2 <- tested2[tested2$adj.P.Val < 0.01,]
dim(DE2)
10）Handling time series data
biocLite("Mfuzz")
library(Mfuzz)
biocLite("affyPLM")
library(affyPLM)
data(yeast)
plotDensity(yeast)
boxplot(yeast)
yeast_norm <- normalize.ExpressionSet.quantile(yeast)
pData(yeast_norm)
times <- pData(yeast_norm)$time
times <- as.factor(times)
design <- model.matrix(~0 +factor(pData(yeast_norm)$time))
colnames(design)[1:17] <- c("C", paste("T", 0:16, sep=""))
cont <- makeContrasts(C-T1, C-T2, C-T3, C-T4, C-T5, C-T6, C-T7,
C-T8, C-T9, C-T10, C-T11, C-T12, C-T13, C-T14, C-T15, C-T16,
levels=design)
fit <- lmFit(yeast_norm, cont)
fitE <- eBayes(fit)
x <- topTable(fitE, adjust="fdr", sort.by="F", number=100)
x[x$adj.P.Val< 0.05,]
11）Fold changes in microarray data
head(DE2)
myTable <- topTable(fit, number=10000)
logratio <- tested2$logFC
library(gtools)
LR <- foldchange2logratio(foldchange, base=2)
FC <- logratio2foldchange(logratio, base=2)
plot(tested2$logFC, -log10(tested2$P.Value),xlim=c(-10, 10),
ylim=c(0, 15), xlab="log2 fold change", ylab="-log10 p-value")
myTable[tested2$P.Val< 0.05&logFC>1.5,]
