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

+Version: 1.5.34

 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>

@@ -47,6 +47,8 @@ getFeatureData.Affy <- function(cdfName, copynumber=FALSE){

 		M[index, "chromosome"] <- cnProbes[, grep("chr", colnames(cnProbes))]

 		M[index, "isSnp"] <- 0L

 	}

+	##A few of the snpProbes do not match -- I think it is chromosome Y.

+	M[is.na(M[, "isSnp"]), "isSnp"] <- 1L

 	return(new("AnnotatedDataFrame", data=data.frame(M)))

 	##list(snpIndex, npIndex, fns)

 	##crlmmOpts$snpRange <- range(snpIndex)

@@ -68,63 +70,23 @@ construct <- function(filenames, cdfName, copynumber=FALSE, sns){

 	sampleNames(callSet) <- sns

 	return(callSet)

 }

+setMethod("close", "AlleleSet", function(con, ...){

+	object <- con

+	names <- ls(assayData(object))

+	L <- length(names)

+	for(i in 1:L) close(eval(substitute(assayData(object)[[NAME]], list(NAME=names[i]))))

+	return()

+})

+setMethod("open", "AlleleSet", function(con, ...){

+	object <- con

+	names <- ls(assayData(object))

+	L <- length(names)

+	for(i in 1:L) open(eval(substitute(assayData(object)[[NAME]], list(NAME=names[i]))))

+	return()

+})

 setReplaceMethod("calls", "SnpSuperSet", function(object, value) assayDataElementReplace(object, "call", value))

 setReplaceMethod("confs", "SnpSuperSet", function(object, value) assayDataElementReplace(object, "callProbability", value))

 setMethod("confs", "SnpSuperSet", function(object) assayDataElement(object, "callProbability"))

-crlmm.batch <- function(object,

-			batchSize,

-			mixtureParams,

-			probs=rep(1/3,3),

-			DF=6,

-			SNRMin=5,

-			recallMin=10,

-			recallRegMin=1000,

-			gender=NULL,

-			desctrucitve=FALSE,

-			verbose=TRUE,

-			returnParams=FALSE,

-			badSNP=0.7){

-	##Call in batches to reduce ram

-	BS <- batchSize

-	nc <- ncol(object)

-	if(nc > BS){

-		N <- ceiling(nc/BS)

-		S <- ceiling(nc/N)

-		colindex <- split(1:nc, rep(1:nc, each=S, length.out=nc))

-	} else {

-		colindex <- list(1:nc)

-	}

-	if(length(colindex) > 1)

-		message("Calling genotypes in batches of size ", length(colindex[[1]]), " to reduce required RAM")

-	row.index <- which(isSnp(object)==1 | is.na(isSnp(object)))

-	for(i in seq(along=colindex)){

-		col.index <- colindex[[i]]

-		tmp <- crlmmGT(A=A(object)[row.index, col.index],

-			       B=B(object)[row.index, col.index],

-			       SNR=object$SNR[col.index],

-			       mixtureParams=mixtureParams[, col.index],

-			       cdfName=annotation(object),

-			       row.names=featureNames(object)[row.index],

-			       col.names=sampleNames(object)[col.index],

-			       probs=probs,

-			       DF=DF,

-			       SNRMin=SNRMin,

-			       recallMin=recallMin,

-			       recallRegMin=recallRegMin,

-			       gender=gender,

-			       desctrucitve=desctrucitve,

-			       verbose=verbose,

-			       returnParams=returnParams,

-			       badSNP=badSNP)

-		##ensure matrix is passed

-		calls(object)[row.index, col.index] <- tmp[["calls"]]

-		confs(object)[row.index, col.index] <- tmp[["confs"]]

-		object$gender[col.index] <- tmp$gender

-		rm(tmp); gc()

-	}

-	return(object)

-}

-

 genotype <- function(filenames, cdfName, mixtureSampleSize=10^5,

 		     fitMixture=TRUE,

 		     eps=0.1, verbose=TRUE,

@@ -143,60 +105,66 @@ genotype <- function(filenames, cdfName, mixtureSampleSize=10^5,

 	if(missing(sns)) sns <- basename(filenames)

 	## callSet contains potentially very big matrices

 	## More big matrices are created within snprma, that will then be removed.

-	snprmaRes <- snprma(filenames=filenames,

-			    mixtureSampleSize=mixtureSampleSize,

-			    fitMixture=fitMixture,

-			    eps=eps,

-			    verbose=verbose,

-			    seed=seed,

-			    cdfName=cdfName,

-			    sns=sns)

-	message("Initializing container for assay data elements alleleA, alleleB, call, callProbability")

 	callSet <- construct(filenames=filenames,

 			     cdfName=cdfName,

 			     copynumber=copynumber,

 			     sns=sns)

-	sampleStats <- data.frame(SKW=snprmaRes$SKW,

-				  SNR=snprmaRes$SNR)

-	pD <- new("AnnotatedDataFrame",

-		  data=sampleStats,

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

-	sampleNames(pD) <- sampleNames(callSet)

-	phenoData(callSet) <- pD

-	if(!copynumber){

-		## A and B are the right size

-		A(callSet) <- snprmaRes[["A"]]  ## should work regardless of ff, matrix

-		B(callSet) <- snprmaRes[["B"]]

-	} else {

-		## A and B are not big enough to hold the nonpolymorphic markers

-		index <- which(fData(callSet)[, "isSnp"] == 1)

-		## Inefficient.  

-		## write one column at a time (????).  (we don't want to bring in the whole matrix if its huge)

-		if(isPackageLoaded("ff")){

-			for(j in 1:ncol(callSet)){

-				A(callSet)[index, j] <- snprmaRes[["A"]][, j]  

-				B(callSet)[index, j] <- snprmaRes[["B"]][, j]

-			}

-			delete(snprmaRes[["A"]])##removes the file on disk

-			delete(snprmaRes[["B"]])##removes the file on disk

-		} else {

-			A(callSet)[index, ] <- snprmaRes[["A"]]

-			B(callSet)[index, ] <- snprmaRes[["B"]]

-		}

+	mixtureParams <- matrix(NA, 4, length(filenames))

+	snp.index <- which(isSnp(callSet)==1)

+	batches <- splitIndicesByLength(1:ncol(callSet), ocSamples())

+	for(j in batches){

+		snprmaRes <- snprma(filenames=filenames[j],

+				    mixtureSampleSize=mixtureSampleSize,

+				    fitMixture=fitMixture,

+				    eps=eps,

+				    verbose=verbose,

+				    seed=seed,

+				    cdfName=cdfName,

+				    sns=sns)

+		stopifnot(identical(featureNames(callSet)[snp.index], snprmaRes$gns))

+		message("Initializing container for assay data elements alleleA, alleleB, call, callProbability")

+		pData(callSet)$SKW[j] <- snprmaRes$SKW

+		pData(callSet)$SNR[j] <- snprmaRes$SNR

+		A(callSet)[snp.index, j] <- snprmaRes[["A"]]

+		B(callSet)[snp.index, j] <- snprmaRes[["B"]]

+		mixtureParams[, j] <- snprmaRes$mixtureParams

+		rm(snprmaRes); gc()

+	}

+	## remove snprmaRes and garbage collect before quantile-normalizing NP probes 

+	if(copynumber){

+		np.index <- which(isSnp(callSet) == 0)

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

+				  cdfName=cdfName,

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

+				  sns=sns,

+				  seed=seed,

+				  verbose=verbose)

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

+		A(callSet)[np.index, j] <- cnrmaRes

+		rm(cnrmaRes); gc()

 	}

-	gc()

-	callSet <- crlmm.batch(object=callSet,

-				batchSize=batchSize,

-				mixtureParams=snprmaRes$mixtureParams,

-				probs=probs,

-				DF=DF,

-				SNRMin=SNRMin,

-				recallMin=recallMin,

-				recallRegMin=recallRegMin,

-				gender=gender,

-				verbose=verbose,

-				returnParams=returnParams,

-				badSNP=badSNP)

+	for(j in batches){

+		tmp <- crlmmGT(A=A(callSet)[snp.index, j],

+			       B=B(callSet)[snp.index, j],

+			       SNR=callSet$SNR[j],

+			       mixtureParams=mixtureParams[, j],

+			       cdfName=annotation(callSet),

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

+			       col.names=sampleNames(callSet)[j],

+			       probs=probs,

+			       DF=DF,

+			       SNRMin=SNRMin,

+			       recallMin=recallMin,

+			       recallRegMin=recallRegMin,

+			       gender=gender,

+			       verbose=verbose,

+			       returnParams=returnParams,

+			       badSNP=badSNP)

+		calls(callSet)[snp.index, j] <- tmp[["calls"]]

+		confs(callSet)[snp.index, j] <- tmp[["confs"]]

+		callSet$gender[j] <- tmp$gender

+		rm(tmp); gc()

+	}	

 	return(callSet)

 }

@@ -671,26 +639,18 @@ whichPlatform <- function(cdfName){

 # steps: quantile normalize hapmap: create 1m_reference_cn.rda object

-cnrma <- function(filenames, cdfName, sns, seed=1, verbose=FALSE, outdir){

+cnrma <- function(filenames, cdfName, row.names, sns, seed=1, verbose=FALSE){

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

 	pkgname <- getCrlmmAnnotationName(cdfName)

 	require(pkgname, character.only=TRUE) || stop("Package ", pkgname, " not available")

 	if (missing(sns)) sns <- basename(filenames)

         loader("npProbesFid.rda", .crlmmPkgEnv, pkgname)

 	fid <- getVarInEnv("npProbesFid")

+	fid <- fid[match(row.names, names(fid))]

 	set.seed(seed)

 	idx2 <- sample(length(fid), 10^5) ##for skewness. no need to do everything

 	SKW <- vector("numeric", length(filenames))

-##	if(bigmemory){

-##		NP <- filebacked.big.matrix(length(pnsa), length(filenames),

-##					    type="integer",

-##					    init=as.integer(0),

-##					    backingpath=outdir,

-##					    backingfile="NP.bin",

-##					    descriptorfile="NP.desc")

-##	} else{

-		NP <- matrix(NA, length(fid), length(filenames))

-##	}

+	NP <- matrix(NA, length(fid), length(filenames))

 	verbose <- TRUE

 	if(verbose){

 		message("Processing ", length(filenames), " files.")

@@ -716,9 +676,9 @@ cnrma <- function(filenames, cdfName, sns, seed=1, verbose=FALSE, outdir){

 	}

 	dimnames(NP) <- list(names(fid), sns)

 	##dimnames(NP) <- list(map[, "man_fsetid"], sns)

-	res3 <- list(NP=NP, SKW=SKW)

+	##res3 <- list(NP=NP, SKW=SKW)

 	cat("\n")

-	return(res3)

+	return(NP)

 }

 getFlags <- function(object, PHI.THR){

@@ -42,11 +42,8 @@ snprma <- function(filenames, mixtureSampleSize=10^5, fitMixture=FALSE, eps=0.1,

   ##S will hold (A+B)/2 and M will hold A-B

   ##NOTE: We actually dont need to save S. Only for pics etc...

   ##f is the correction. we save to avoid recomputing

-  ##**RS**

-  ##A <- matrix(as.integer(0), length(pnsa), length(filenames))

-  ##B <- matrix(as.integer(0), length(pnsb), length(filenames))

-  A <- initializeBigMatrix(name="tmpA", length(pnsa), length(filenames))

-  B <- initializeBigMatrix(name="tmpB", length(pnsa), length(filenames))

+  A <- matrix(as.integer(0), length(pnsa), length(filenames))

+  B <- matrix(as.integer(0), length(pnsb), length(filenames))

   if(verbose){

     message("Processing ", length(filenames), " files.")