@@ -1,7 +1,7 @@

 Package: crlmm

 Type: Package

 Title: Genotype Calling (CRLMM) and Copy Number Analysis tool for Affymetrix SNP 5.0 and 6.0 and Illumina arrays.

-Version: 1.7.8

+Version: 1.7.9

 Date: 2010-07-30

 Author: Rafael A Irizarry, Benilton S Carvalho <carvalho@bclab.org>, Robert Scharpf <rscharpf@jhsph.edu>, Matt Ritchie <mritchie@wehi.edu.au>

 Maintainer: Benilton S Carvalho <carvalho@bclab.org>, Robert Scharpf <rscharpf@jhsph.edu>, Matt Ritchie <mritchie@wehi.EDU.AU>

@@ -3111,7 +3111,51 @@ computeCopynumber.CNSet <- function(object, cnOptions){

-

-

-

-

+## constructors for Illumina platform

+constructIlluminaFeatureData <- function(gns, cdfName){

+	pkgname <- paste(cdfName, "Crlmm", sep="")	

+	path <- system.file("extdata", package=pkgname)

+	load(file.path(path, "cnProbes.rda"))

+	load(file.path(path, "snpProbes.rda"))

+	cnProbes$chr <- chromosome2integer(cnProbes$chr)

+	cnProbes <- as.matrix(cnProbes)

+	snpProbes$chr <- chromosome2integer(snpProbes$chr)

+	snpProbes <- as.matrix(snpProbes)

+	mapping <- rbind(snpProbes, cnProbes, deparse.level=0)

+	mapping <- mapping[match(gns, rownames(mapping)), ]

+	isSnp <- 1L-as.integer(gns %in% rownames(cnProbes))

+	mapping <- cbind(mapping, isSnp, deparse.level=0)

+	stopifnot(identical(rownames(mapping), gns))

+	colnames(mapping) <- c("chromosome", "position", "isSnp")

+	new("AnnotatedDataFrame",

+	    data=data.frame(mapping),

+	    varMetadata=data.frame(labelDescription=colnames(mapping)))	

+}

+constructIlluminaAssayData <- function(np, snp, object, storage.mode="environment", order.index){

+	stopifnot(identical(snp$gns, featureNames(object)))

+	gns <- c(featureNames(object), np$gns)

+	sns <- np$sns

+	np <- np[1:2]

+	snp <- snp[1:2]

+	stripnames <- function(x) {

+		dimnames(x) <- NULL

+		x

+	}

+	np <- lapply(np, stripnames)

+	snp <- lapply(snp, stripnames)

+	A <- rbind(snp[[1]], np[[1]], deparse.level=0)[order.index, ]

+	B <- rbind(snp[[2]], np[[2]], deparse.level=0)[order.index, ]

+	gt <- stripnames(calls(object))

+	emptyMatrix <- matrix(integer(), nrow(np[[1]]), ncol(A))

+	gt <- rbind(gt, emptyMatrix, deparse.level=0)[order.index,]

+	pr <- stripnames(snpCallProbability(object))

+	pr <- rbind(pr, emptyMatrix, deparse.level=0)[order.index, ]

+	emptyMatrix <- matrix(integer(), nrow(A), ncol(A))	

+	aD <- assayDataNew(storage.mode,

+			   alleleA=A,

+			   alleleB=B,

+			   call=gt,

+			   callProbability=pr,

+			   CA=emptyMatrix,

+			   CB=emptyMatrix)

+}

@@ -1,88 +0,0 @@

-setClassUnion("integerOrMissing", c("integer", "missing", "numeric"))

-setGeneric("totalCopyNumber", function(object, i, j, ...) standardGeneric("totalCopyNumber"))

-setMethod("totalCopyNumber",

-	  signature=signature(object="CNSet", i="integerOrMissing", j="integerOrMissing"),

-	  function(object, i, j, ...){

-	if(missing(i) & missing(j)){

-		if(inherits(CA(object), "ff") | inherits(CA(object), "ffdf")) stop("Must specify i and/or j for ff objects")

-	}

-	if(missing(i) & !missing(j)){

-		snp.index <- which(isSnp(object))	

-		cn.total <- as.matrix(CA(object)[, j])

-		if(length(snp.index) > 0){

-			cb <- as.matrix(CB(object)[snp.index, j])

-			snps <- (1:nrow(cn.total))[i %in% snp.index]

-			cn.total[snps, ] <- cn.total[snps, j] + cb				

-		}

-	}

-	if(!missing(i) & missing(j)){

-		snp.index <- intersect(which(isSnp(object)), i)

-		cn.total <- as.matrix(CA(object)[i, ])

-		if(length(snp.index) > 0){

-			cb <- as.matrix(CB(object)[snp.index, ])

-			snps <- (1:nrow(cn.total))[i %in% snp.index]

-			cn.total[snps, ] <- cn.total[snps, ] + cb				

-		}

-	}

-	if(!missing(i) & !missing(j)){

-		snp.index <- intersect(which(isSnp(object)), i)		

-		cn.total <- as.matrix(CA(object)[i, j])

-		if(length(snp.index) > 0){

-			cb <- as.matrix(CB(object)[snp.index, j])

-			snps <- (1:nrow(cn.total))[i %in% snp.index]

-			cn.total[snps, ] <- cn.total[snps, ] + cb

-		}

-	}

-	cn.total <- cn.total/100

-	dimnames(cn.total) <- NULL

-	return(cn.total)

-})

-

-

-constructFeatureData <- function(gns, cdfName){

-	pkgname <- paste(cdfName, "Crlmm", sep="")	

-	path <- system.file("extdata", package=pkgname)

-	load(file.path(path, "cnProbes.rda"))

-	load(file.path(path, "snpProbes.rda"))

-	cnProbes$chr <- chromosome2integer(cnProbes$chr)

-	cnProbes <- as.matrix(cnProbes)

-	snpProbes$chr <- chromosome2integer(snpProbes$chr)

-	snpProbes <- as.matrix(snpProbes)

-	mapping <- rbind(snpProbes, cnProbes, deparse.level=0)

-	mapping <- mapping[match(gns, rownames(mapping)), ]

-	isSnp <- 1L-as.integer(gns %in% rownames(cnProbes))

-	mapping <- cbind(mapping, isSnp, deparse.level=0)

-	stopifnot(identical(rownames(mapping), gns))

-	colnames(mapping) <- c("chromosome", "position", "isSnp")

-	new("AnnotatedDataFrame",

-	    data=data.frame(mapping),

-	    varMetadata=data.frame(labelDescription=colnames(mapping)))	

-}

-constructAssayData <- function(np, snp, object, storage.mode="environment", order.index){

-	stopifnot(identical(snp$gns, featureNames(object)))

-	gns <- c(featureNames(object), np$gns)

-	sns <- np$sns

-	np <- np[1:2]

-	snp <- snp[1:2]

-	stripnames <- function(x) {

-		dimnames(x) <- NULL

-		x

-	}

-	np <- lapply(np, stripnames)

-	snp <- lapply(snp, stripnames)

-	A <- rbind(snp[[1]], np[[1]], deparse.level=0)[order.index, ]

-	B <- rbind(snp[[2]], np[[2]], deparse.level=0)[order.index, ]

-	gt <- stripnames(calls(object))

-	emptyMatrix <- matrix(integer(), nrow(np[[1]]), ncol(A))

-	gt <- rbind(gt, emptyMatrix, deparse.level=0)[order.index,]

-	pr <- stripnames(snpCallProbability(object))

-	pr <- rbind(pr, emptyMatrix, deparse.level=0)[order.index, ]

-	emptyMatrix <- matrix(integer(), nrow(A), ncol(A))	

-	aD <- assayDataNew(storage.mode,

-			   alleleA=A,

-			   alleleB=B,

-			   call=gt,

-			   callProbability=pr,

-			   CA=emptyMatrix,

-			   CB=emptyMatrix)

-}

@@ -48,7 +48,9 @@ options(continue=" ")

 <<libraries>>=

 library(crlmm)

 crlmm:::validCdfNames()

-outdir <- "/thumper/ctsa/snpmicroarray/rs/data/hapmap/crlmmVignette/release/illumina"

+if(length(grep("development", sessionInfo()[[1]]$status)) == 1){

+	outdir <- "/thumper/ctsa/snpmicroarray/rs/data/hapmap/crlmmVignette/devel/illumina"	

+} else outdir <- "/thumper/ctsa/snpmicroarray/rs/data/hapmap/crlmmVignette/release/illumina"	

 dir.create(outdir, showWarnings=FALSE, recursive=TRUE)

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

 @ 

@@ -88,25 +90,24 @@ redfiles = all(file.exists(paste(arrayNames, "_Red.idat", sep="")))

 @ 

 <<samplesToProcess2, echo=FALSE>>=

-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()

-	} 

-}

+## To speed up repeated calls to Sweave 

+RG <- checkExists("RG", .path=outdir,

+		  .FUN=readIdatFiles,

+		  sampleSheet=samplesheet,

+		  path=dirname(arrayNames[1]),

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

+		  saveDate=TRUE)

+annotation(RG) <- "human370v1c"

+crlmmResult <- checkExists("crlmmResult",

+			   .path=outdir,

+			   .FUN=crlmmIllumina,

+			   RG=RG,

+			   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

 @ 

 <<samplesToProcess3, eval=FALSE>>=

@@ -114,6 +115,7 @@ RG <- readIdatFiles(samplesheet,

 		    path=dirname(arrayNames[1]), 

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

 		    saveDate=TRUE)

+annotation(RG) <- "human370v1c"

 crlmmResult <- crlmmIllumina(RG=RG, 

 			     cdfName="human370v1c", 

 			     sns=pData(RG)$ID, 

@@ -122,8 +124,6 @@ crlmmResult <- crlmmIllumina(RG=RG,

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

 			     save.it=TRUE)

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

-range(protocolData(crlmmResult)$ScanDate)

-rm(RG); gc()

 @ 

 \noindent Finally, we load a few of the intermediate files that were

@@ -133,17 +133,11 @@ load(file.path(outdir, "snpFile.rda"))

 res <- get("res")

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

 cnAB <- get("cnAB")

-load(file.path(outdir, "crlmmResult.rda"))

 @ 

-<<loadIntermediate, eval=TRUE, echo=FALSE>>=

-if(!exists("res")){

-	load(file.path(outdir, "snpFile.rda"))

-	res <- get("res")

-	load(file.path(outdir, "cnFile.rda"))

-	cnAB <- get("cnAB")

-	load(file.path(outdir, "crlmmResult.rda"))

-}

+<<loadIntermediate, echo=FALSE>>=

+res <- checkExists("res", .path=outdir, .FUN=load, file=file.path(outdir, "snpFile.rda"))

+cnAB <- checkExists("cnAB", .path=outdir, .FUN=load, file=file.path(outdir, "cnFile.rda"))

 @ 

 After running the crlmm algorithm, we construct a container for