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,]

12）The functional enrichment of data