@@ -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.5.35

+Version: 1.5.36

 Date: 2010-02-05

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

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

@@ -1,4 +1,9 @@

 setOldClass("ffdf")

 setOldClass("ff_matrix")

 ##setClassUnion("matrix_or_ff", c("matrix", "ff_matrix"))

-##setClassUnion("list_or_ffdf", c("list", "ffdf"))

+setClassUnion("list_or_ffdf", c("list", "ffdf"))

+setClass("CNSetLM", contains="CNSet", representation(lM="list_or_ffdf"))

+setMethod("initialize", "CNSetLM", function(.Object, CA=new("matrix"), CB=new("matrix"), lM=new("list"), ...){

+	.Object <- callNextMethod(.Object, CA=CA, CB=CB, lM=lM, ...)

+	.Object

+})

@@ -92,7 +92,6 @@ genotype <- function(filenames, cdfName, mixtureSampleSize=10^5,

 		     fitMixture=TRUE,

 		     eps=0.1, verbose=TRUE,

 		     seed=1, sns, copynumber=FALSE,

-		     batchSize=1000,

 		     probs=rep(1/3, 3),

 		     DF=6,

 		     SNRMin=5,

@@ -138,7 +137,7 @@ genotype <- function(filenames, cdfName, mixtureSampleSize=10^5,

 		cnrmaRes <- cnrma(filenames=filenames[j],

 				  cdfName=cdfName,

 				  row.names=featureNames(callSet)[np.index],				  

-				  sns=sns,

+				  sns=sns[j],

 				  seed=seed,

 				  verbose=verbose)

 		stopifnot(identical(featureNames(callSet)[np.index], rownames(cnrmaRes)))

@@ -381,85 +380,40 @@ harmonizeDimnamesTo <- function(object1, object2){

 	return(object1)

 }

-crlmmCopynumber <- function(filenames, cnOptions, object, ...){

-	if(!missing(object)){

-		stopifnot(class(object) == "CNSet")

-		createIntermediateObjects <- FALSE

-	} else {

-		createIntermediateObjects <- TRUE

-		crlmmResults <- crlmmWrapper(filenames, cnOptions, ...)

-		snprmaResult <- crlmmResults[["snprmaResult"]]

-		cnrmaResult <- crlmmResults[["cnrmaResult"]]

-		callSet <- crlmmResults[["callSet"]]

-		rm(crlmmResults); gc()

-		annotation(callSet) <- cnOptions[["cdfName"]]

-		stopifnot(identical(featureNames(callSet), snprmaResult[["gns"]]))

-		path <- system.file("extdata", package=paste(annotation(callSet), "Crlmm", sep=""))	

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

-		snpProbes <- get("snpProbes")

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

-		cnProbes <- get("cnProbes")	

-		k <- grep("chr", colnames(snpProbes))

-		if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")

-	}

-	set.seed(cnOptions[["seed"]])  ##for reproducibility

+

+

+crlmmCopynumber <- function(object, cnOptions, ...){

 	chromosome <- cnOptions[["chromosome"]]

-	SNRmin <- cnOptions[["SNRmin"]]

-	for(CHR in chromosome){

-		cat("Chromosome ", CHR, "\n")

-		if(createIntermediateObjects){

-			snps <- rownames(snpProbes)[snpProbes[, k] == CHR]

-			cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]

-			index.snps <- match(snps, featureNames(callSet))

-			index.nps <- match(cnps, rownames(cnrmaResult[["NP"]]))

-			if(!is.null(cnrmaResult)){

-				npI <- cnrmaResult$NP[index.nps, ]

-			} else npI <- NULL

-			snpI <- list(A=snprmaResult$A[index.snps, ],

-				     B=snprmaResult$B[index.snps, ],

-				     sns=snprmaResult$sns,

-				     gns=snprmaResult$gns[index.snps],

-				     SNR=snprmaResult$SNR,

-				     SKW=snprmaResult$SKW,

-				     mixtureParams=snprmaResult$mixtureParams,

-				     cdfName=snprmaResult$cdfName)

-			cnOptions[["batch"]] <- cnOptions[["batch"]][snpI[["SNR"]]  >= SNRmin]

-			cnSet <- combineIntensities(res=snpI,

-						    NP=npI,

-						    callSet=callSet[index.snps, ])

-			if(any(cnSet$SNR > SNRmin)){

-				message(paste("Excluding samples with SNR < ", SNRmin))

-				cnSet <- cnSet[, cnSet$SNR >= SNRmin]

-			}

-			rm(snpI, npI, snps, cnps, index.snps, index.nps); gc()

-			pData(cnSet)$batch <- cnOptions[["batch"]]

-			featureData(cnSet) <- lm.parameters(cnSet, cnOptions)

-		} else {

-			cnSet <- object

-		}

-		if(CHR != 24){		

-			cnSet <- computeCopynumber(cnSet, cnOptions)

-		} else{

-			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSet' object for this chromosome")

-			alleleSet <- cnSet

-			save(alleleSet, file=file.path(cnOptions[["outdir"]], paste("alleleSet_", CHR, ".rda", sep="")))

-			rm(cnSet, alleleSet); gc()

-			next()

-		}

-		if(length(chromosome) == 1){

-			if(cnOptions[["save.cnset"]]){

-				save(cnSet, file=file.path(cnOptions[["outdir"]], paste("cnSet_", CHR, ".rda", sep="")))

-			}

-		}

-		if(length(chromosome) > 1){

-			save(cnSet, file=file.path(cnOptions[["outdir"]], paste("cnSet_", CHR, ".rda", sep="")))

-			rm(cnSet); gc()

-		} else {

-			return(cnSet)

+	which.batch <- cnOptions[["whichbatch"]]

+	SNRMin <- cnOptions[["SNRMin"]]

+	cnSet <- new("CNSetLM",

+		     alleleA=A(object),

+		     alleleB=B(object),

+		     call=calls(object),

+		     callProbability=confs(object),

+		     CA=initializeBigMatrix("CA", nrow(object), ncol(object)),

+		     CB=initializeBigMatrix("CB", nrow(object), ncol(object)),

+		     annotation=annotation(object),

+		     featureData=featureData(object),

+		     experimentData=experimentData(object),

+		     phenoData=phenoData(object))

+	rm(object); gc()

+	if(any(cnSet$SNR < SNRMin)){

+		message("Excluding ", sum(cnSet$SNR < SNRMin), " samples with SNR below ", SNRMin)

+		cnSet <- cnSet[, cnSet$SNR > SNRMin]

+	}

+	batches <- split(1:ncol(cnSet), cnSet$batch)

+	if(any(sapply(batches, length) < MIN.SAMPLES)) message("Excluding batches with fewer than ", MIN.SAMPLES, " samples")

+	batches <- batches[sapply(batches, length) >= MIN.SAMPLES]

+	for(i in chromosome){

+		cat("Chromosome ", i, "\n")

+		for(j in batches){

+			if(i >= 24) next()

+			row.index <- which(chromosome(cnSet) == i)

+			tmp <- computeCopynumber(cnSet[row.index, j], cnOptions)

+			##message("Copy number estimates not available for chromosome Y.  Saving only the 'callSet' object for this chromosome")

 		}

 	}

-	saved.objects <- list.files(cnOptions[["outdir"]], pattern="cnSet", full.names=TRUE)		

-	return(saved.objects)

 }

@@ -731,15 +685,16 @@ thresholdCopynumber <- function(object){

 ##

 ##}

-cnOptions <- function(outdir="./",

-		      cdfName,

-		      crlmmFile,

-		      intensityFile,

-		      rgFile="rgFile.rda",

-		      save.it=TRUE,

-		      save.cnset=TRUE,

-		      load.it=TRUE,

-		      splitByChr=TRUE,

+cnOptions <- function(

+##		      outdir="./",

+##		      cdfName,

+##		      crlmmFile,

+##		      intensityFile,

+##		      rgFile="rgFile.rda",

+##		      save.it=TRUE,

+##		      save.cnset=TRUE,

+##		      load.it=TRUE,

+##		      splitByChr=TRUE,

 		      MIN.OBS=3,

 		      MIN.SAMPLES=10,

 		      batch=NULL,

@@ -763,32 +718,33 @@ cnOptions <- function(outdir="./",

 ##		      cbsOpts=NULL,

 		      ##hmmOpts=NULL,

 		      ...){

-	if(missing(cdfName)) stop("must specify cdfName")

-	if(!file.exists(outdir)){

-		message(outdir, " does not exist.  Trying to create it.")

-		dir.create(outdir, recursive=TRUE)

-	}

-	stopifnot(isValidCdfName(cdfName))

-##	if(hiddenMarkovModel){

-##		hmmOpts <- hmmOptions(...)

+##	if(missing(cdfName)) stop("must specify cdfName")

+##	if(!file.exists(outdir)){

+##		message(outdir, " does not exist.  Trying to create it.")

+##		dir.create(outdir, recursive=TRUE)

 ##	}

-	if(missing(crlmmFile)){

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

-	}

-	if(missing(intensityFile)){

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

-	}

-	if(is.null(batch))

-		stop("must specify batch -- should be the same length as the number of files")

-	list(outdir=outdir,

-	     cdfName=cdfName,

-	     crlmmFile=crlmmFile,

-	     intensityFile=intensityFile,

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

-	     save.it=save.it,

-	     save.cnset=save.cnset,

-	     load.it=load.it,

-	     splitByChr=splitByChr,

+##	stopifnot(isValidCdfName(cdfName))

+####	if(hiddenMarkovModel){

+####		hmmOpts <- hmmOptions(...)

+####	}

+##	if(missing(crlmmFile)){

+##		crlmmFile <- file.path(outdir, "snpsetObject.rda")

+##	}

+##	if(missing(intensityFile)){

+##		intensityFile <- file.path(outdir, "normalizedIntensities.rda")

+##	}

+##	if(is.null(batch))

+##		stop("must specify batch -- should be the same length as the number of files")

+	list(

+##	     outdir=outdir,

+##	     cdfName=cdfName,

+##	     crlmmFile=crlmmFile,

+##	     intensityFile=intensityFile,

+##	     rgFile=file.path(outdir, rgFile),

+##	     save.it=save.it,

+##	     save.cnset=save.cnset,

+##	     load.it=load.it,

+##	     splitByChr=splitByChr,

 	     MIN.OBS=MIN.OBS,

 	     MIN.SAMPLES=MIN.SAMPLES,

 	     batch=batch,

@@ -1,20 +1,45 @@

-setAs("SnpSuperSet", "CNSet",

-      function(from, to){

-	      CA <- CB <- matrix(NA, nrow(from), ncol(from))

-	      dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  

-	      new("CNSet",

-		  call=calls(from),

-		  callProbability=assayData(from)[["callProbability"]],  ##confs(from) returns 1-exp(-x/1000)

-		  alleleA=A(from),

-		  alleleB=B(from),

-		  CA=CA,

-		  CB=CB,

-		  phenoData=phenoData(from),

-		  experimentData=experimentData(from),

-		  annotation=annotation(from),

-		  protocolData=protocolData(from),

-		  featureData=featureData(from))

-      })

+setMethod("show", "CNSet", function(object){

+	callNextMethod(object)

+	cat("lM: ", length(lM(object)), " elements \n")

+	print(names(lM(object)))

+})

+setMethod("[", "CNSet", function(x, i, j, ..., drop=FALSE){

+	x <- callNextMethod(x, i, j, ..., drop=drop)

+	if(!missing(i)){

+		if(class(lM(x)) == "ffdf"){

+			lM(x) <- lapply(physical(lM(x)), function(x, i){open(x); x[i, ]}, i=i)

+		} else {

+			lM(x) <- lapply(lM(x), function(x, i) x[i, , drop=FALSE], i=i)

+		}

+	}

+	x

+})

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

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

+setMethod("lM", "CNSet", function(object) object@lM)

+##setMethod("linearModelParam", "AffymetrixCNSet", function(object) object@linearModelParam)

+setReplaceMethod("lM", c("CNSet", "list_or_ffdf"), function(object, value){

+	object@lM <- value

+	object

+})

+

+##setAs("SnpSuperSet", "CNSet",

+##      function(from, to){

+##	      CA <- CB <- matrix(NA, nrow(from), ncol(from))

+##	      dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  

+##	      new("CNSet",

+##		  call=calls(from),

+##		  callProbability=assayData(from)[["callProbability"]],  ##confs(from) returns 1-exp(-x/1000)

+##		  alleleA=A(from),

+##		  alleleB=B(from),

+##		  CA=CA,

+##		  CB=CB,

+##		  phenoData=phenoData(from),

+##		  experimentData=experimentData(from),

+##		  annotation=annotation(from),

+##		  protocolData=protocolData(from),

+##		  featureData=featureData(from))

+##      })

 setMethod("computeCopynumber", "CNSet", function(object, cnOptions){

 	## to do the bias adjustment, initial estimates of the parameters are needed

@@ -151,39 +176,3 @@ ellipse.CNSet <- function(x, copynumber, batch, ...){

 }

-

-

-

-

-setMethod("show", "CNSet", function(object){

-	callNextMethod(object)

-##	cat("emissionPr\n")

-##	cat("   array:", nrow(object), "features,", ncol(object), "samples,", dim(emissionPr(object))[3], "states\n")

-##	cat("   hidden states:\n")

-##	cat("      ", dimnames(emissionPr(object))[[3]], "\n")

-##	cat("   Missing values:", sum(is.na(emissionPr(object))), "\n")

-##	if(!all(is.na(emissionPr(object)))){

-##		cat("   minimum value:", min(emissionPr(object), na.rm=TRUE), "\n")

-##	} else  cat("   minimum value: NA (all missing)\n")

-##	cat("rangedData:  ")

-##	cat("    ", show(rangedData(object)), "\n")

-})

-##setMethod("rangedData", "CNSet", function(object) segmentData(object))

-##setReplaceMethod("rangedData", c("CNSet", "RangedData"), function(object, value){

-##	segmentData(object) <- value

-##})

-##

-##setMethod("segmentData", "CNSet", function(object) object@segmentData)

-##setReplaceMethod("segmentData", c("CNSet", "RangedData"), function(object, value){

-##	object@segmentData <- value

-##	object

-##})

-##

-##setMethod("emissionPr", "CNSet", function(object) object@emissionPr)

-##setReplaceMethod("emissionPr", c("CNSet", "array"), function(object, value){

-##	object@emissionPr <- value

-##	object

-##})

-##setMethod("start", "CNSet", function(x, ...) start(segmentData(x), ...))

-##setMethod("end", "CNSet", function(x, ...) end(segmentData(x), ...))

-##setMethod("width", "CNSet", function(x) width(segmentData(x)))

new file mode 100644

@@ -0,0 +1,62 @@

+\name{genotype}

+\alias{genotype}

+\title{

+	Preprocessing and genotyping of Affymetrix arrays.

+}

+\description{

+	Preprocessing and genotyping of Affymetrix arrays.	

+}

+\usage{

+genotype(filenames, cdfName, mixtureSampleSize = 10^5, fitMixture = TRUE, eps = 0.1, verbose = TRUE, seed = 1, sns, copynumber = FALSE, probs = rep(1/3, 3), DF = 6, SNRMin = 5, recallMin = 10, recallRegMin = 1000, gender = NULL, returnParams = TRUE, badSNP = 0.7)

+}

+\arguments{

+  \item{filenames}{ complete path to CEL files}

+  \item{cdfName}{  annotation package  (see also \code{validCdfNames})}

+  \item{mixtureSampleSize}{}

+  \item{fitMixture}{}

+  \item{eps}{}

+  \item{verbose}{  Logical.  Whether to print descriptive messages during processing.}

+  \item{seed}{  Integer. Useful for reproducibility}

+  \item{sns}{The sample identifiers.  If missing, the default sample names are \code{basename(filenames)}}

+  \item{copynumber}{ Whether to quantile normalize the nonpolymorphic probes.  If TRUE, the quantile normalized intensities for nonpolymorphic markers are included in the 'A' matrix.}

+  \item{probs}{}

+  \item{DF}{}

+  \item{SNRMin}{}

+  \item{recallMin}{ }

+  \item{recallRegMin}{}

+  \item{gender}{  integer (  male = 1, female =2 ) or missing.  If missing, the gender is predicted.}

+  \item{returnParams}{}

+  \item{badSNP}{}

+}

+\details{

+}

+\value{	A \code{SnpSuperSet} instance.}

+\references{

+

+  Carvalho B, Bengtsson H, Speed TP, Irizarry RA. Exploration,

+  normalization, and genotype calls of high-density oligonucleotide SNP

+  array data. Biostatistics. 2007 Apr;8(2):485-99. Epub 2006 Dec

+  22. PMID: 17189563.

+

+  Carvalho BS, Louis TA, Irizarry RA. 

+  Quantifying uncertainty in genotype calls.

+  Bioinformatics. 2010 Jan 15;26(2):242-9.

+

+}

+\author{R. Scharpf}

+\note{}

+

+\seealso{

+	\code{\link{snprma}}, \code{\link{crlmm}}, \code{\link{validCdfNames}}

+}

+\examples{

+if (require(genomewidesnp5Crlmm) & require(hapmapsnp5)){

+  path <- system.file("celFiles", package="hapmapsnp5")

+  ## the filenames with full path...

+  ## very useful when genotyping samples not in the working directory

+  cels <- list.celfiles(path, full.names=TRUE)

+  (crlmmOutput <- genotype(cels))

+}

+}

+\keyword{ classif }

+