@@ -8,7 +8,6 @@ setMethod("initialize", "CNSetLM", function(.Object, lM=new("list"), ...){

 	.Object@lM <- lM

 	.Object <- callNextMethod(.Object, ...)

 })

-

 setValidity("CNSetLM",

 	    function(object){

 		    if(!"batch" %in% varLabels(protocolData(object)))

@@ -8,4 +8,5 @@ setGeneric("snpIndex", function(object) standardGeneric("snpIndex"))

 setGeneric("snpNames", function(object) standardGeneric("snpNames"))

 setGeneric("lM", function(object) standardGeneric("lM"))

 setGeneric("lM<-", function(object, value) standardGeneric("lM<-"))

+setGeneric("totalCopyNumber", function(object,...) standardGeneric("totalCopyNumber"))

@@ -87,11 +87,7 @@ readIdatFiles <- function(sampleSheet=NULL,

 	       cat("reading", arrayNames[i], "\t")

 	       idsG = idsR = G = R = NULL

 	       cat(paste(sep, fileExt$green, sep=""), "\t")

-	       G <- tryCatch(readIDAT(grnidats[i]), error=function(e) NULL)

-	       if(is.null(G)) { 

-		       if(i==1) stop("Read in of first IDAT file failed - check your data")

-     		   else cat("\n"); next()

-		   }

+	       G = readIDAT(grnidats[i])

 	       idsG = rownames(G$Quants)

 	       headerInfo$nProbes[i] = G$nSNPsRead

 	       headerInfo$Barcode[i] = G$Barcode

@@ -265,11 +261,7 @@ readIdatFiles2 <- function(sampleSheet=NULL,

 	       cat("reading", arrayNames[i], "\t")

 	       idsG = idsR = G = R = NULL

 	       cat(paste(sep, fileExt$green, sep=""), "\t")

-	       G <- tryCatch(readIDAT(grnidats[i]), error=function(e) NULL)

-	       if(is.null(G)) { 

-		       if(i==1) stop("Read in of first IDAT file failed - check your data")

-     		   else cat("\n"); next()

-		   }

+	       G = readIDAT(grnidats[i])

 	       idsG = rownames(G$Quants)

 	       headerInfo$nProbes[i] = G$nSNPsRead

 	       headerInfo$Barcode[i] = G$Barcode

new file mode 100644

@@ -0,0 +1,2 @@

+illumina_copynumber.tex

+Makefile

@@ -5,6 +5,8 @@

 \documentclass{article}

 \usepackage{graphicx}

 \usepackage{natbib}

+\usepackage[margin=1in]{geometry}

+\newcommand{\crlmm}{\Rpackage{crlmm}}

 \newcommand{\Rfunction}[1]{{\texttt{#1}}}

 \newcommand{\Rmethod}[1]{{\texttt{#1}}}

 \newcommand{\Rcode}[1]{{\texttt{#1}}}

@@ -16,48 +18,115 @@

 \begin{document}

 \title{Copy number estimation and genotype calling with \Rpackage{crlmm}}

-\date{Oct, 2009}

+\date{\today}

 \author{Rob Scharpf}

 \maketitle

+Allele-specific copy number estimation in the crlmm package is

+available for several Illumina platforms.  As described in the

+\texttt{copynumber.pdf} vignette, this algorithm works best when there

+are a sufficient number of samples such that AA, AB, and BB genotypes

+are observed at most loci. For small studies (e.g., fewer than 50

+samples), there will be a large number of SNPs that are

+monomorphic. For monomorphic SNPs, the estimation problem becomes more

+difficult and alternative strategies that estimate the relative total

+copy number (as to absolute allele-specific copy number) may be

+preferable.  In the following code, we list the platforms for which

+annotation packages are available for computations performed by

+\crlmm{}. Next we create a directory where output files will be stored

+and indicate the directory that contains the IDAT files that will be

+used in our analysis.

+

 <<setup, echo=FALSE, results=hide>>=

-options(width=60)

+options(width=70)

 options(continue=" ")

-options(prompt="R> ")

 @ 

 <<>>=

 library(crlmm)

 crlmm:::validCdfNames()

-outdir <- "/thumper/ctsa/snpmicroarray/rs/data/hapmap/illumina/HumanCNV370-Duo"

+outdir <- "/thumper/ctsa/snpmicroarray/rs/ProcessedData/crlmm/trunk/illumina_vignette"

 datadir <- "/thumper/ctsa/snpmicroarray/illumina/IDATS/370k"

 cdfName <- "human370v1c"

 @ 

+To perform copy number analysis on the Illumina platform, several

+steps are required.  The first step is to read in the IDAT files and

+create a container for storing the red and green intensities. These

+intensities are quantile normalized in the function

+\Rfunction{crlmmIllumina}, and then genotyped using the crlmm

+algorithm.  Details on the crlmm genotyping algorithm are described

+elsewhere.  It is important to specify \Robject{save.it = TRUE} and

+provide output files to store the quantile normalized intensities. We

+will make use of the normalized intensities when we estimate copy

+number.  The object returned by \Rfunction{crlmmIllumina} in an

+instance of the \Robject{SnpSet} class, a container for storing the

+genotype calls and the genotype confidence scores.  The genotype

+confidence scores are saved as an integer, and can be converted back

+to a $[0, 1]$ probability scale by the transformation

+$round(-1000*log2(1-p))$.  At this point, one may want to extract the

+scan date of the arrays for later use.  The scan dates can be pulled

+from the RG object and added to the \Robject{SnpSet} returned by

+\Rfunction{crlmmIllumina} as illustrated below.

+

 <<samplesToProcess>>=

 samplesheet = read.csv(file.path(datadir, "HumanHap370Duo_Sample_Map.csv"), header=TRUE, as.is=TRUE)

-## Excluding a few of the problem samples

 samplesheet <- samplesheet[-c(28:46,61:75,78:79), ]

 arrayNames <- file.path(datadir, unique(samplesheet[, "SentrixPosition"]))

 ##Check that files exist

-grnfiles = all(file.exists(paste(arrayNames, ".Grn.dat", sep="")))

-redfiles = all(file.exists(paste(arrayNames, ".Red.dat", sep="")))

-@ 

-

-Alternatively, arguments to the readIdatFiles can be passed through the

-{\tt ...} argument of the \R{} function \Robject{crlmmWrapper}.

-

-<<wrapper>>=

-crlmmWrapper(sampleSheet=samplesheet,

-	     arrayNames=arrayNames,

-	     arrayInfoColNames=list(barcode=NULL, position="SentrixPosition"), 

-	     saveDate=TRUE,

-	     cdfName=cdfName,

-	     load.it=FALSE,

-	     save.it=FALSE,

-	     intensityFile=file.path(outdir, "normalizedIntensities.rda"),

-	     crlmmFile=file.path(outdir, "snpsetObject.rda"),

-	     rgFile=file.path(outdir, "rgFile.rda"))

+grnfiles = all(file.exists(paste(arrayNames, "_Grn.idat", sep="")))

+redfiles = all(file.exists(paste(arrayNames, "_Red.idat", sep="")))

+myfun <- function(outdir, filenames, samplesheet, arrayInfoColNames, cdfName, cnFile, snpFile){

+	if(missing(cnFile)) cnFile <- file.path(outdir, "cnFile.rda")

+	if(missing(snpFile)) snpFile <- file.path(outdir, "snpFile.rda")

+	RG <- readIdatFiles(sampleSheet=samplesheet, 

+			    path=dirname(filenames), 

+			    arrayInfoColNames=arrayInfoColNames,

+			    saveDate=TRUE)	

+	crlmmResult <- crlmmIllumina(RG=RG, 

+				     cdfName="human370v1c", 

+				     sns=pData(RG)$ID, 

+				     returnParams=TRUE,

+				     cnFile=cnFile,

+				     snpFile=snpFile,

+				     save.it=TRUE)	

+	protocolData(crlmmResult)$ScanDate <- protocolData(RG)$ScanDate

+	range(protocolData(crlmmResult)$ScanDate)

+	return(crlmmResult)

+}

+trace(myfun, browser)

+crlmmResult <- checkExists("crlmmResult", path=outdir, FUN=myfun,

+			   outdir=outdir,

+			   filenames=arrayNames,

+			   samplesheet=samplesheet,

+			   arrayInfoColNames=list(barcode=NULL, position="SentrixPosition"),

+			   cdfName=cdfName)

+##if(!exists("crlmmResult")){

+##	if(!file.exists(file.path(outdir, "crlmmResult.rda"))){

+##		RG <- readIdatFiles(samplesheet, 

+##				    path=dirname(arrayNames[1]), 

+##				    arrayInfoColNames=list(barcode=NULL, position="SentrixPosition"), 

+##				    saveDate=TRUE)

+##		crlmmResult <- crlmmIllumina(RG=RG, 

+##					     cdfName="human370v1c", 

+##					     sns=pData(RG)$ID, 

+##					     returnParams=TRUE,

+##					     cnFile=file.path(outdir, "cnFile.rda"),

+##					     snpFile=file.path(outdir, "snpFile.rda"),

+##					     save.it=TRUE)

+##		protocolData(crlmmResult)$ScanDate <- protocolData(RG)$ScanDate

+##		range(protocolData(crlmmResult)$ScanDate)

+##		save(crlmmResult, file=file.path(outdir, "crlmmResult.rda"))

+##		rm(RG); gc()

+##	} else {

+##		message("Loading previously saved crlmm results")

+##		load(file.path(outdir, "snpFile.rda"))

+##		res <- get("res")

+##		load(file.path(outdir, "cnFile.rda"))

+##		cnAB <- get("cnAB")

+##		load(file.path(outdir, "crlmmResult.rda"))

+##	}

+##}

 @ 

 This creates a \Robject{crlmmSetList} object in the \Robject{outdir}

@@ -94,6 +163,104 @@ load(filename)

 cn <- copyNumber(crlmmSetList)

 @ 

+The following helper function can facilitate access to the total copy

+number.

+

+<<copyNumberHelper>>=

+trace(totalCopyNumber, browser, signature="CNSet")

+cn.total2 <- totalCopyNumber(cnSet, i=which(chromosome(cnSet)==1), j=1:20)

+@ 

+

+A few simple visualizations may be helpful at this point. The first

+plot is a histogram of the signal to noise ratio of the sample -- an

+overall measure of how well the genotype clusters separate.  (This

+statistic tends to be much higher for Illumina than for the Affymetrix

+platforms.) The second is a visualization of the total copy number

+estimates plotted versus physical position on chromosome 1 for the two

+samples with the lowest (top) and highest (bottom) signal to noise

+ratios.  

+

+<<snr, fig=TRUE>>=

+hist(cnSet$SNR, breaks=15)

+@ 

+

+<<firstSample, fig=TRUE>>=

+low.snr <- which(cnSet$SNR == min(cnSet$SNR))

+high.snr <- which(cnSet$SNR == max(cnSet$SNR))

+x <- position(cnSet)[chromosome(cnSet) == 1]

+par(mfrow=c(2,1), las=1, mar=c(0.5, 4, 0.5, 0.5), oma=c(4, 1, 1,1))

+for(j in c(low.snr, high.snr)){

+	cn <- copyNumber(cnSet)[, j]/100

+	cn[cn < 0.05] <- 0.05

+	plot(x,

+	     cn[chromosome(cnSet) == 1],

+	     pch=".", ylab="copy number", xaxt="n", log="y")

+}

+axis(1, at=pretty(x), labels=pretty(x/1e6))

+mtext("Mb", 1, outer=TRUE, line=2)

+@ 

+

+Here's a very simple approach to handle outliers by applying a running

+median using a window of size 3.  Following outlier removal, we

+suggest applying a wave correction to adjust for more global waves

+followed by a segmentation or hidden markov model.

+

+<<removeOutliers, fig=TRUE>>=

+par(mfrow=c(2,1), las=1, mar=c(0.5, 4, 0.5, 0.5), oma=c(4, 1, 1,1))

+for(j in c(low.snr, high.snr)){

+	x <- position(cnSet)[chromosome(cnSet)==1]

+	cn <- copyNumber(cnSet)[, j]/100

+	cn[cn < 0.05] <- 0.05

+	##cn <- log(cn)

+	x <- x[!is.na(cn)]

+	cn <- cn[!is.na(cn)]

+	y <- as.numeric(runmed(cn, k=3))

+	plot(x,

+	     y,

+	     pch=".", ylab="copy number", xaxt="n", log="y", ylim=c(0.5,5))

+	legend("topright", bty="n", legend=paste("SNR =", round(cnSet$SNR[j], 1)))

+	abline(h=2, col="grey70")

+}

+axis(1, at=pretty(x), labels=pretty(x/1e6))

+mtext("Mb", 1, outer=TRUE, line=2)

+@ 

+

+%Next we remove some of the waves using \Rpackage{limma}'s function

+%\Rfunction{loessFit}.

+%<<wavecorrection, fig=TRUE>>=

+%require(limma)

+%par(mfrow=c(2,2), las=1, mar=c(0.5, 4, 0.5, 0.5), oma=c(4, 1, 1,1))

+%for(j in c(low.snr, high.snr)){

+%	y <- copyNumber(cnSet)[chromosome(cnSet) == 1, j]/100

+%	missing <- is.na(y)

+%	x <- x[!missing]

+%	y <- y[!missing]

+%	dist <- diff(x)

+%	index <- c(0, cumsum(log10(dist) > 6))

+%	x.split <- split(x, index)

+%	y <- as.numeric(runmed(y, k=3))

+%	y.split <- split(y, index)

+%	y.smooth <- vector("list", length(y.split))

+%	for(i in seq_along(y.smooth)){

+%		fit <- loessFit(y=y.split[[i]], x= x.split[[i]], span=0.3)

+%		y.smooth[[i]] <- 2+fit$residuals 

+%	}

+%	plot(unlist(x.split),

+%	     unlist(y.split),

+%	     pch=".", ylab="copy number", xaxt="n", log="y", ylim=c(0.5,5))

+%	plot(unlist(x.split),

+%	     unlist(y.smooth),

+%	     pch=".", ylab="copy number", xaxt="n", log="y", ylim=c(0.5,5), yaxt="n")

+%	legend("topright", bty="n", legend=paste("SNR =", round(cnSet$SNR[j], 1)))

+%	abline(h=2, col="grey70")	

+%	if(j == high.snr){

+%		axis(1, at=pretty(x), labels=pretty(x/1e6))

+%		mtext("Mb", 1, outer=TRUE, line=2)

+%	}

+%}

+%@ 

+

+

 \end{document}