@@ -1,3 +1,5 @@

+test*

+myCrlmmGT2.Rnw

 ffobjs*

 auto*

 ModelForPolymorphicX.pdf

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

+Version: 1.9.13

 Date: 2010-12-10

 Author: Benilton S Carvalho <Benilton.Carvalho@cancer.org.uk>, Robert Scharpf <rscharpf@jhsph.edu>, Matt Ritchie <mritchie@wehi.edu.au>, Ingo Ruczinski <iruczins@jhsph.edu>, Rafael A Irizarry

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

@@ -24,7 +24,8 @@ Imports: affyio (>= 1.19.2),

 Suggests: hapmapsnp6,

           genomewidesnp6Crlmm (>= 1.0.4),

           snpMatrix,

-	  ellipse

+	  ellipse,

+	  RUnit

 Collate: AllGenerics.R

 	 AllClasses.R

 	 methods-AssayData.R

@@ -39,5 +40,6 @@ Collate: AllGenerics.R

 	 plot-methods.R

          utils.R

          zzz.R

+	 test_crlmm_package.R

 LazyLoad: yes

 biocViews: Microarray, Preprocessing, SNP, Bioinformatics, CopyNumberVariants

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

 useDynLib("crlmm", .registration=TRUE)

-## this is temporary

-exportPattern("^[^\\.]")

-

 ##---------------------------------------------------------------------------

 ## Biobase

 ##---------------------------------------------------------------------------

@@ -47,7 +47,7 @@ getFeatureData <- function(cdfName, copynumber=FALSE){

 		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

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

 	M <- data.frame(M)

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

 }

@@ -60,6 +60,9 @@ construct <- function(filenames,

 	if(!missing(batch)){

 		stopifnot(length(batch) == length(sns))

 	}

+	if(any(is.na(batch))){

+		stop("NA's in batch variable")

+	}

 	if(missing(sns) & missing(filenames)) stop("one of filenames or samplenames (sns) must be provided")

 	if(verbose) message("Initializing container for copy number estimation")

 	featureData <- getFeatureData(cdfName, copynumber=copynumber)

@@ -109,7 +112,7 @@ genotype <- function(filenames,

 		       SNRMin=5,

 		       recallMin=10,

 		       recallRegMin=1000,

-		       gender=NULL,

+		     gender=NULL,

 		       returnParams=TRUE,

 		       badSNP=0.7){

 	is.lds <- ifelse(isPackageLoaded("ff"), TRUE, FALSE)

@@ -151,7 +154,7 @@ genotype <- function(filenames,

 		 mixtureSampleSize=mixtureSampleSize, pkgname=pkgname,

 		 neededPkgs=c("crlmm", pkgname))

 	## Now we initialize a CNSet object, cloning A and B

-	message("Cloning A and B objects")

+	if(verbose) message("Cloning A and B matrices to store genotype calls and confidence scores.")

 	## The clones will be used to store calls and confidence scores

 	open(A)

 	open(B)

@@ -171,15 +174,13 @@ genotype <- function(filenames,

 		     batch=batch)

 	if(!missing(sns)){

 		sampleNames(cnSet) <- sns

-		open(A)

-		protocolData <- annotatedDataFrameFrom(A(cnSet), byrow=FALSE)

-		close(A)

 	} else {

 		sampleNames(cnSet) <- basename(filenames)

-		protocolData <- getProtocolData.Affy(filenames)

 	}

+	protocolData <- getProtocolData.Affy(filenames)

 	rownames(pData(protocolData)) <- sns

 	protocolData(cnSet) <- protocolData

+	##protocolData(cnSet) <- protocolData

 	pd <- data.frame(matrix(NA, nc, 3), row.names=sns)

 	colnames(pd)=c("SKW", "SNR", "gender")

 	phenoData(cnSet) <- new("AnnotatedDataFrame", data=pd)

@@ -213,7 +214,7 @@ genotype <- function(filenames,

 			  returnParams=returnParams,

 			  badSNP=badSNP)

 	if(verbose) message("Genotyping finished.  Updating container with genotype calls and confidence scores.")

-	cnSet$gender <- tmp$gender

+	cnSet$gender <- tmp[["gender"]]

 	return(cnSet)

 }

@@ -359,37 +360,39 @@ fit.wls <- function(NN, sigma, allele, Y, autosome, X){

 }

 shrinkGenotypeSummaries <- function(strata, index.list, object, MIN.OBS, MIN.SAMPLES, DF.PRIOR,

-				    verbose, is.lds){

-	if(is.lds) {physical <- get("physical"); open(object)}

+				    verbose, is.lds=TRUE){

+	##if(is.lds) {physical <- get("physical"); open(object)}

+	open(object)

 	if(verbose) message("      Probe stratum ", strata, " of ", length(index.list))

 	marker.index <- index.list[[strata]]

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

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

-	batchnames <- batchNames(object)

-	N.AA <- as.matrix(N.AA(object)[marker.index, ])

-	N.AB <- as.matrix(N.AB(object)[marker.index, ])

-	N.BB <- as.matrix(N.BB(object)[marker.index, ])

-	medianA.AA <- as.matrix(medianA.AA(object)[marker.index,])

-	medianA.AB <- as.matrix(medianA.AB(object)[marker.index,])

-	medianA.BB <- as.matrix(medianA.BB(object)[marker.index,])

-	medianB.AA <- as.matrix(medianB.AA(object)[marker.index,])

-	medianB.AB <- as.matrix(medianB.AB(object)[marker.index,])

-	medianB.BB <- as.matrix(medianB.BB(object)[marker.index,])

-	madA.AA <- as.matrix(madA.AA(object)[marker.index,])

-	madA.AB <- as.matrix(madA.AB(object)[marker.index,])

-	madA.BB <- as.matrix(madA.BB(object)[marker.index,])

-	madB.AA <- as.matrix(madB.AA(object)[marker.index,])

-	madB.AB <- as.matrix(madB.AB(object)[marker.index,])

-	madB.BB <- as.matrix(madB.BB(object)[marker.index,])

-	medianA <- medianB <- shrink.madB <- shrink.madA <- vector("list", length(batchnames))

-	shrink.tau2A.AA <- tau2A.AA <- as.matrix(tau2A.AA(object)[marker.index,])

-	shrink.tau2B.BB <- tau2B.BB <- as.matrix(tau2B.BB(object)[marker.index,])

-	shrink.tau2A.BB <- tau2A.BB <- as.matrix(tau2A.BB(object)[marker.index,])

-	shrink.tau2B.AA <- tau2B.AA <- as.matrix(tau2B.AA(object)[marker.index,])

-	shrink.corrAA <- corrAA <- as.matrix(corrAA(object)[marker.index, ])

-	shrink.corrAB <- corrAB <- as.matrix(corrAB(object)[marker.index, ])

-	shrink.corrBB <- corrBB <- as.matrix(corrBB(object)[marker.index, ])

-	flags <- as.matrix(flags(object)[marker.index, ])

+	batch.names <- batchNames(object)

+	batch.index <- which(batchNames(object) %in% batch.names)

+	N.AA <- as.matrix(N.AA(object)[marker.index, batch.index])

+	N.AB <- as.matrix(N.AB(object)[marker.index, batch.index])

+	N.BB <- as.matrix(N.BB(object)[marker.index, batch.index])

+	medianA.AA <- as.matrix(medianA.AA(object)[marker.index, batch.index])

+	medianA.AB <- as.matrix(medianA.AB(object)[marker.index, batch.index])

+	medianA.BB <- as.matrix(medianA.BB(object)[marker.index, batch.index])

+	medianB.AA <- as.matrix(medianB.AA(object)[marker.index, batch.index])

+	medianB.AB <- as.matrix(medianB.AB(object)[marker.index, batch.index])

+	medianB.BB <- as.matrix(medianB.BB(object)[marker.index, batch.index])

+	madA.AA <- as.matrix(madA.AA(object)[marker.index, batch.index])

+	madA.AB <- as.matrix(madA.AB(object)[marker.index, batch.index])

+	madA.BB <- as.matrix(madA.BB(object)[marker.index, batch.index])

+	madB.AA <- as.matrix(madB.AA(object)[marker.index, batch.index])

+	madB.AB <- as.matrix(madB.AB(object)[marker.index, batch.index])

+	madB.BB <- as.matrix(madB.BB(object)[marker.index, batch.index])

+	medianA <- medianB <- shrink.madB <- shrink.madA <- vector("list", length(batch.names))

+	shrink.tau2A.AA <- tau2A.AA <- as.matrix(tau2A.AA(object)[marker.index, batch.index])

+	shrink.tau2B.BB <- tau2B.BB <- as.matrix(tau2B.BB(object)[marker.index, batch.index])

+	shrink.tau2A.BB <- tau2A.BB <- as.matrix(tau2A.BB(object)[marker.index, batch.index])

+	shrink.tau2B.AA <- tau2B.AA <- as.matrix(tau2B.AA(object)[marker.index, batch.index])

+	shrink.corrAA <- corrAA <- as.matrix(corrAA(object)[marker.index, batch.index])

+	shrink.corrAB <- corrAB <- as.matrix(corrAB(object)[marker.index, batch.index])

+	shrink.corrBB <- corrBB <- as.matrix(corrBB(object)[marker.index, batch.index])

+	flags <- as.matrix(flags(object)[marker.index, batch.index])

 	for(k in seq(along=batches)){

 		sample.index <- batches[[k]]

 		this.batch <- unique(as.character(batch(object)[sample.index]))

@@ -422,9 +425,6 @@ shrinkGenotypeSummaries <- function(strata, index.list, object, MIN.OBS, MIN.SAM

 		## SNPs that we'll use for imputing location/scale of unobserved genotypes

 		##---------------------------------------------------------------------------

 		index.complete <- indexComplete(NN, medianA[[k]], medianB[[k]], MIN.OBS)

-		if(length(index.complete) == 1){

-			if(index.complete == FALSE) return()

-		}

 		##

 		##---------------------------------------------------------------------------

 		## Impute sufficient statistics for unobserved genotypes (plate-specific)

@@ -459,46 +459,32 @@ shrinkGenotypeSummaries <- function(strata, index.list, object, MIN.OBS, MIN.SAM

 		negB <- rowSums(medianB[[k]] < 0) > 0

 		flags[, k] <- as.integer(rowSums(NN == 0) > 0 | negA | negB)

 	}

-	if(length(batches) >= 3){

-		if(verbose) message("Imputing centers for unobserved genotypes from other batches")

-		res <- imputeAcrossBatch(N.AA, N.AB, N.BB,

-					 medianA.AA, medianA.AB, medianA.BB,

-					 medianB.AA, medianB.AB, medianB.BB)

-		medianA.AA <- res[["medianA.AA"]]

-		medianA.AB <- res[["medianA.AB"]]

-		medianA.BB <- res[["medianA.BB"]]

-		medianB.AA <- res[["medianB.AA"]]

-		medianB.AB <- res[["medianB.AB"]]

-		medianB.BB <- res[["medianB.BB"]]

-		updated <- res[["updated"]]

-	}

-	flags(object)[marker.index, ] <- flags

-	medianA.AA(object)[marker.index, ] <- do.call("cbind", lapply(medianA, function(x) x[, 1]))

-	medianA.AB(object)[marker.index, ] <- do.call("cbind", lapply(medianA, function(x) x[, 2]))

-	medianA.BB(object)[marker.index, ] <- do.call("cbind", lapply(medianA, function(x) x[, 3]))

-	medianB.AA(object)[marker.index, ] <- do.call("cbind", lapply(medianB, function(x) x[, 1]))

-	medianB.AB(object)[marker.index, ] <- do.call("cbind", lapply(medianB, function(x) x[, 2]))

-	medianB.BB(object)[marker.index, ] <- do.call("cbind", lapply(medianB, function(x) x[, 3]))

+	flags(object)[marker.index, batch.index] <- flags

+	medianA.AA(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianA, function(x) x[, 1]))

+	medianA.AB(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianA, function(x) x[, 2]))

+	medianA.BB(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianA, function(x) x[, 3]))

+	medianB.AA(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianB, function(x) x[, 1]))

+	medianB.AB(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianB, function(x) x[, 2]))

+	medianB.BB(object)[marker.index, batch.index] <- do.call("cbind", lapply(medianB, function(x) x[, 3]))

 	##

-	madA.AA(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 1]))

-	madA.AB(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 2]))

-	madA.BB(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 3]))

-	madB.AA(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 1]))

-	madB.AB(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 2]))

-	madB.BB(object)[marker.index, ] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 3]))

+	madA.AA(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 1]))

+	madA.AB(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 2]))

+	madA.BB(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madA, function(x) x[, 3]))

+	madB.AA(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 1]))

+	madB.AB(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 2]))

+	madB.BB(object)[marker.index, batch.index] <- do.call("cbind", lapply(shrink.madB, function(x) x[, 3]))

 	##

-	corrAA(object)[marker.index, ] <- shrink.corrAA

-	corrAB(object)[marker.index, ] <- shrink.corrAB

-	corrBB(object)[marker.index, ] <- shrink.corrBB

-	tau2A.AA(object)[marker.index,] <- shrink.tau2A.AA

-	tau2A.BB(object)[marker.index,] <- shrink.tau2A.BB

-	tau2B.AA(object)[marker.index,] <- shrink.tau2B.AA

-	tau2B.BB(object)[marker.index,] <- shrink.tau2B.BB

+	corrAA(object)[marker.index, batch.index] <- shrink.corrAA

+	corrAB(object)[marker.index, batch.index] <- shrink.corrAB

+	corrBB(object)[marker.index, batch.index] <- shrink.corrBB

+	tau2A.AA(object)[marker.index, batch.index] <- shrink.tau2A.AA

+	tau2A.BB(object)[marker.index, batch.index] <- shrink.tau2A.BB

+	tau2B.AA(object)[marker.index, batch.index] <- shrink.tau2B.AA

+	tau2B.BB(object)[marker.index, batch.index] <- shrink.tau2B.BB

 	if(is.lds) return(TRUE) else return(object)

 }

-

 fit.lm1 <- function(strata,

 		    index.list,

 		    object,

@@ -513,34 +499,38 @@ fit.lm1 <- function(strata,

 	snps <- index.list[[strata]]

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

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

-	batchnames <- batchNames(object)

-	N.AA <- as.matrix(N.AA(object)[snps, ])

-	N.AB <- as.matrix(N.AB(object)[snps, ])

-	N.BB <- as.matrix(N.BB(object)[snps, ])

-	medianA.AA <- as.matrix(medianA.AA(object)[snps,])

-	medianA.AB <- as.matrix(medianA.AB(object)[snps,])

-	medianA.BB <- as.matrix(medianA.BB(object)[snps,])

-	medianB.AA <- as.matrix(medianB.AA(object)[snps,])

-	medianB.AB <- as.matrix(medianB.AB(object)[snps,])

-	medianB.BB <- as.matrix(medianB.BB(object)[snps,])

-	madA.AA <- as.matrix(madA.AA(object)[snps,])

-	madA.AB <- as.matrix(madA.AB(object)[snps,])

-	madA.BB <- as.matrix(madA.BB(object)[snps,])

-	madB.AA <- as.matrix(madB.AA(object)[snps,])

-	madB.AB <- as.matrix(madB.AB(object)[snps,])

-	madB.BB <- as.matrix(madB.BB(object)[snps,])

-	tau2A.AA <- as.matrix(tau2A.AA(object)[snps,])

-	tau2B.BB <- as.matrix(tau2B.BB(object)[snps,])

-	tau2A.BB <- as.matrix(tau2A.BB(object)[snps,])

-	tau2B.AA <- as.matrix(tau2B.AA(object)[snps,])

-	corrAA <- as.matrix(corrAA(object)[snps, ])

-	corrAB <- as.matrix(corrAB(object)[snps, ])

-	corrBB <- as.matrix(corrBB(object)[snps, ])

-	nuA <- as.matrix(nuA(object)[snps, ])

-	phiA <- as.matrix(phiA(object)[snps, ])

-	nuB <- as.matrix(nuB(object)[snps, ])

-	phiB <- as.matrix(phiB(object)[snps, ])

-	flags <- as.matrix(flags(object)[snps, ])

+	##batchnames <- batchNames(object)

+	batch.names <- names(batches)

+	batch.index <- which(batchNames(object) %in% batch.names)

+	if(length(batches) > 1 && "grandMean" %in% batchNames(object))

+		batch.index <- c(batch.index, match("grandMean", batchNames(object)))

+	N.AA <- as.matrix(N.AA(object)[snps, batch.index])

+	N.AB <- as.matrix(N.AB(object)[snps, batch.index])

+	N.BB <- as.matrix(N.BB(object)[snps, batch.index])

+	medianA.AA <- as.matrix(medianA.AA(object)[snps, batch.index])

+	medianA.AB <- as.matrix(medianA.AB(object)[snps, batch.index])

+	medianA.BB <- as.matrix(medianA.BB(object)[snps, batch.index])

+	medianB.AA <- as.matrix(medianB.AA(object)[snps, batch.index])

+	medianB.AB <- as.matrix(medianB.AB(object)[snps, batch.index])

+	medianB.BB <- as.matrix(medianB.BB(object)[snps, batch.index])

+	madA.AA <- as.matrix(madA.AA(object)[snps, batch.index])

+	madA.AB <- as.matrix(madA.AB(object)[snps, batch.index])

+	madA.BB <- as.matrix(madA.BB(object)[snps, batch.index])

+	madB.AA <- as.matrix(madB.AA(object)[snps, batch.index])

+	madB.AB <- as.matrix(madB.AB(object)[snps, batch.index])

+	madB.BB <- as.matrix(madB.BB(object)[snps, batch.index])

+	tau2A.AA <- as.matrix(tau2A.AA(object)[snps, batch.index])

+	tau2B.BB <- as.matrix(tau2B.BB(object)[snps, batch.index])

+	tau2A.BB <- as.matrix(tau2A.BB(object)[snps, batch.index])

+	tau2B.AA <- as.matrix(tau2B.AA(object)[snps, batch.index])

+	corrAA <- as.matrix(corrAA(object)[snps, batch.index])

+	corrAB <- as.matrix(corrAB(object)[snps, batch.index])

+	corrBB <- as.matrix(corrBB(object)[snps, batch.index])

+	nuA <- as.matrix(nuA(object)[snps,  batch.index])

+	phiA <- as.matrix(phiA(object)[snps, batch.index])

+	nuB <- as.matrix(nuB(object)[snps, batch.index])

+	phiB <- as.matrix(phiB(object)[snps, batch.index])

+	flags <- as.matrix(flags(object)[snps, batch.index])

 	for(k in seq(along=batches)){

 		B <- batches[[k]]

 		if(length(B) < MIN.SAMPLES) next()

@@ -550,7 +540,29 @@ fit.lm1 <- function(strata,

 		madA <- cbind(madA.AA[, k], madA.AB[, k], madA.BB[, k])

 		madB <- cbind(madB.AA[, k], madB.AB[, k], madB.BB[, k])

 		NN <- cbind(N.AA[, k], N.AB[, k], N.BB[, k])

-		## we're regressing on the medians using the standard errors (hence the division by N) as weights

+		## regress on the medians using the standard errors (hence the division by N) as weights

+		res <- fit.wls(NN=NN, sigma=madA, allele="A", Y=medianA, autosome=!CHR.X)

+		nuA[, k] <- res[1, ]

+		phiA[, k] <- res[2, ]

+		rm(res)

+		res <- fit.wls(NN=NN, sigma=madB, allele="B", Y=medianB, autosome=!CHR.X)##allele="B", Ystar=YB, W=wB, Ns=Ns)

+		nuB[, k] <- res[1, ]

+		phiB[, k] <- res[2, ]

+	}

+	##---------------------------------------------------------------------------

+	##

+	## Grand mean

+	##

+	##---------------------------------------------------------------------------

+	if(length(batches) > 1 && "grandMean" %in% batchNames(object)){

+		## then the last column is for the grandMean

+		k <- ncol(medianA.AA)

+		medianA <- cbind(medianA.AA[, k], medianA.AB[, k], medianA.BB[, k])

+		medianB <- cbind(medianB.AA[, k], medianB.AB[, k], medianB.BB[, k])

+		madA <- cbind(madA.AA[, k], madA.AB[, k], madA.BB[, k])

+		madB <- cbind(madB.AA[, k], madB.AB[, k], madB.BB[, k])

+		NN <- cbind(N.AA[, k], N.AB[, k], N.BB[, k])

+		##index <- which(rowSums(is.na(medianA)) > 0)

 		res <- fit.wls(NN=NN, sigma=madA, allele="A", Y=medianA, autosome=!CHR.X)

 		nuA[, k] <- res[1, ]

 		phiA[, k] <- res[2, ]

@@ -558,8 +570,6 @@ fit.lm1 <- function(strata,

 		res <- fit.wls(NN=NN, sigma=madB, allele="B", Y=medianB, autosome=!CHR.X)##allele="B", Ystar=YB, W=wB, Ns=Ns)

 		nuB[, k] <- res[1, ]

 		phiB[, k] <- res[2, ]

-##		cA[, k] <- matrix((1/phiA[, J]*(A-nuA[, J])), nrow(A), ncol(A))

-##		cB[, k] <- matrix((1/phiB[, J]*(B-nuB[, J])), nrow(B), ncol(B))

 	}

 	if(THR.NU.PHI){

 		nuA[nuA < MIN.NU] <- MIN.NU

@@ -567,10 +577,10 @@ fit.lm1 <- function(strata,

 		phiA[phiA < MIN.PHI] <- MIN.PHI

 		phiB[phiB < MIN.PHI] <- MIN.PHI

 	}

-	nuA(object)[snps, ] <- nuA

-	nuB(object)[snps, ] <- nuB

-	phiA(object)[snps, ] <- phiA

-	phiB(object)[snps, ] <- phiB

+	nuA(object)[snps, batch.index] <- nuA

+	nuB(object)[snps, batch.index] <- nuB

+	phiA(object)[snps, batch.index] <- phiA

+	phiB(object)[snps, batch.index] <- phiB

 	if(is.lds){

 		close(object)

 		return(TRUE)

@@ -593,30 +603,34 @@ fit.lm2 <- function(strata,

 	marker.index <- index.list[[strata]]

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

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

-

+	batch.names <- names(batches)

+	batch.index <- which(batchNames(object) %in% batch.names)

+	##

 	ii <- isSnp(object) & chromosome(object) < 23 & !is.na(chromosome(object))

-	flags <- as.matrix(flags(object)[ii, ])

+	flags <- as.matrix(flags(object)[ii, batch.index])

 	fns <- featureNames(object)[ii]

 	fns.noflags <- fns[rowSums(flags, na.rm=T) == 0]

 	snp.index <- sample(match(fns.noflags, featureNames(object)), 5000)

-

-	nuA.np <- as.matrix(nuA(object)[marker.index, ])

-	phiA.np <- as.matrix(phiA(object)[marker.index, ])

-	tau2A.AA <- as.matrix(tau2A.AA(object)[marker.index, ])

-

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

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

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

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

-	medianA.AA <- as.matrix(medianA.AA(object)[snp.index,])

-	medianB.BB <- as.matrix(medianB.BB(object)[snp.index,])

-

-	medianA.AA.np <- as.matrix(medianA.AA(object)[marker.index,])

+	##

+	nuA.np <- as.matrix(nuA(object)[marker.index, batch.index])

+	phiA.np <- as.matrix(phiA(object)[marker.index, batch.index])

+	tau2A.AA <- as.matrix(tau2A.AA(object)[marker.index, batch.index])

+	##

+	nuA.snp <- as.matrix(nuA(object)[snp.index, batch.index])

+	nuB.snp <- as.matrix(nuB(object)[snp.index, batch.index])

+	phiA.snp <- as.matrix(phiA(object)[snp.index, batch.index])

+	phiB.snp <- as.matrix(phiB(object)[snp.index, batch.index])

+	medianA.AA <- as.matrix(medianA.AA(object)[snp.index, batch.index])

+	medianB.BB <- as.matrix(medianB.BB(object)[snp.index, batch.index])

+	medianA.AA.np <- as.matrix(medianA.AA(object)[marker.index, batch.index])

 	for(k in seq_along(batches)){

 		B <- batches[[k]]

 		this.batch <- unique(as.character(batch(object)[B]))

 		X <- cbind(1, log2(c(medianA.AA[, k], medianB.BB[, k])))

 		Y <- log2(c(phiA.snp[, k], phiB.snp[, k]))

+		not.missing <- rowSums(is.na(X)) == 0 & !is.na(Y)

+		X <- X[not.missing, ]

+		Y <- Y[not.missing]

 		betahat <- solve(crossprod(X), crossprod(X, Y))

 		##crosshyb <- max(median(medianA.AA[, k]) - median(medianA.AA.np[, k]), 0)

 		crosshyb <- 0

@@ -630,8 +644,8 @@ fit.lm2 <- function(strata,

 		nuA.np[nuA.np < MIN.NU] <- MIN.NU

 		phiA.np[phiA.np < MIN.PHI] <- MIN.PHI

 	}

-	nuA(object)[marker.index, ] <- nuA.np

-	phiA(object)[marker.index, ] <- phiA.np

+	nuA(object)[marker.index, batch.index] <- nuA.np

+	phiA(object)[marker.index, batch.index] <- phiA.np

 	if(is.lds) { close(object); return(TRUE)}

 	return(object)

 }

@@ -645,6 +659,7 @@ summarizeMaleXNps <- function(marker.index,

 	gender <- object$gender

 	AA <- as.matrix(A(object)[marker.index, gender==1])

 	madA.AA <- medianA.AA <- matrix(NA, nr, nc)

+	colnames(madA.AA) <- colnames(medianA.AA) <- batchNames(object)

 	numberMenPerBatch <- rep(NA, nc)

 	for(k in seq_along(batches)){

 		B <- batches[[k]]

@@ -656,8 +671,8 @@ summarizeMaleXNps <- function(marker.index,

 		sns <- colnames(AA)

 		J <- sns%in%sns.batch

 		numberMenPerBatch[k] <- length(J)

-		medianA.AA[, k] <- rowMedians(AA[, J], na.rm=TRUE)

-		madA.AA[, k] <- rowMAD(AA[, J], na.rm=TRUE)

+		medianA.AA[, k] <- rowMedians(AA[, J, drop=FALSE], na.rm=TRUE)

+		madA.AA[, k] <- rowMAD(AA[, J, drop=FALSE], na.rm=TRUE)

 	}

 	return(list(medianA.AA=medianA.AA,

 		    madA.AA=madA.AA))

@@ -665,29 +680,35 @@ summarizeMaleXNps <- function(marker.index,

 summarizeXGenotypes <- function(marker.index,

-				    batches,

-				    object,

-				    GT.CONF.THR,

-				    MIN.OBS,

-				    MIN.SAMPLES,

-				    verbose,

-				    is.lds,

-				    DF.PRIOR,

-				    gender="male", ...){

+				batches,

+				object,

+				GT.CONF.THR,

+				MIN.OBS,

+				MIN.SAMPLES,

+				verbose,

+				is.lds,

+				DF.PRIOR,

+				gender="male", ...){

+	I <- unlist(batches)

 	if(gender == "male"){

-		sample.index <- which(object$gender==1)

-	} else sample.index <- which(object$gender==2)

+		gender.index <- which(object$gender == 1)

+	} else {

+		gender.index <- which(object$gender == 2)

+	}

+	batches <- lapply(batches, function(x, gender.index) intersect(x, gender.index), gender.index)

+	batch.names <- names(batches)

+	batch.index <- which(batchNames(object) %in% batch.names)

 	nr <- length(marker.index)

-	nc <- length(batchNames(object))

-##	NN.Mlist <- imputed.medianA <- imputed.medianB <- shrink.madA <- shrink.madB <- vector("list", nc)

+	nc <- length(batch.index)

 	NN.Mlist <- medianA <- medianB <- shrink.madA <- shrink.madB <- vector("list", nc)

-	##gender <- object$gender

-	GG <- as.matrix(calls(object)[marker.index, sample.index])

-	CP <- as.matrix(snpCallProbability(object)[marker.index, sample.index])

-	AA <- as.matrix(A(object)[marker.index, sample.index])

-	BB <- as.matrix(B(object)[marker.index, sample.index])

+	names(NN.Mlist) <- names(medianA) <- names(medianB) <- names(shrink.madA) <- names(shrink.madB) <- batch.names

+	GG <- as.matrix(calls(object)[marker.index, ])

+	CP <- as.matrix(snpCallProbability(object)[marker.index, ])

+	AA <- as.matrix(A(object)[marker.index, ])

+	BB <- as.matrix(B(object)[marker.index, ])

 	for(k in seq_along(batches)){

 		sample.index <- batches[[k]]

+		if(length(sample.index) == 0) next()

 		this.batch <- unique(as.character(batch(object)[sample.index]))

 		##gender <- object$gender[sample.index]

 		if(length(sample.index) < MIN.SAMPLES) next()

@@ -695,12 +716,13 @@ summarizeXGenotypes <- function(marker.index,

 		##subset GG apppriately

 		sns <- colnames(GG)

 		J <- sns%in%sns.batch

-		G <- GG[, J]

-		xx <- CP[, J]

+		G <- GG[, J, drop=FALSE]

+		xx <- CP[, J, drop=FALSE]

+		p <- i2p(xx)

 		highConf <- (1-exp(-xx/1000)) > GT.CONF.THR

 		G <- G*highConf

-		A <- AA[, J]

-		B <- BB[, J]

+		A <- AA[, J, drop=FALSE]

+		B <- BB[, J, drop=FALSE]

 		G.AA <- G==1

 		G.AA[G.AA==FALSE] <- NA

 		G.AB <- G==2

@@ -774,6 +796,18 @@ summarizeXGenotypes <- function(marker.index,

 			## AB and AA observed

 			unobserved.index[[3]] <- which(unobservedBB & (NN[, 2] >= MIN.OBS & NN[, 1] >= MIN.OBS))

 			res <- imputeCenter(medianA[[k]], medianB[[k]], index.complete, unobserved.index)

+			medianA[[k]] <- res[[1]]

+			medianB[[k]] <- res[[2]]

+

+			## RS: For Monomorphic SNPs a mixture model may be better

+			## RS: Further, we can improve estimation by borrowing strength across batch

+			unobserved.index[[1]] <- which(unobservedAA & unobservedAB)

+			unobserved.index[[2]] <- which(unobservedBB & unobservedAB)

+			unobserved.index[[3]] <- which(unobservedAA & unobservedBB) ## strange

+			res <- imputeCentersForMonomorphicSnps(medianA[[k]], medianB[[k]],

+							       index.complete,

+							       unobserved.index)

+			medianA[[k]] <- res[[1]]; medianB[[k]] <- res[[2]]

 		}

 		medianA[[k]] <- res[[1]]

 		medianB[[k]] <- res[[2]]

@@ -798,7 +832,7 @@ fit.lm3 <- function(strata,

 		    MIN.NU,

 		    MIN.PHI,

 		    verbose, is.lds, CHR.X, ...){

-	if(is.lds) {physical <- get("physical"); open(object)}

+	##if(is.lds) {physical <- get("physical"); open(object)}

 	if(verbose) message("      Probe stratum ", strata, " of ", length(index.list))

 	gender <- object$gender

 	enough.males <- sum(gender==1) >= MIN.SAMPLES

@@ -810,22 +844,25 @@ fit.lm3 <- function(strata,

 	marker.index <- index.list[[strata]]

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

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

-	nuA <- as.matrix(nuA(object)[marker.index, ])

-	nuB <- as.matrix(nuB(object)[marker.index, ])

-	phiA <- as.matrix(phiA(object)[marker.index, ])

-	phiB <- as.matrix(phiB(object)[marker.index, ])

-	phiA2 <- as.matrix(phiPrimeA(object)[marker.index, ])

-	phiB2 <- as.matrix(phiPrimeB(object)[marker.index, ])

+	batch.names <- names(batches)

+	batch.index <- which(batchNames(object) %in% batch.names)

+

+	nuA <- as.matrix(nuA(object)[marker.index, batch.index])

+	nuB <- as.matrix(nuB(object)[marker.index, batch.index])

+	phiA <- as.matrix(phiA(object)[marker.index, batch.index])

+	phiB <- as.matrix(phiB(object)[marker.index, batch.index])

+	phiA2 <- as.matrix(phiPrimeA(object)[marker.index, batch.index])

+	phiB2 <- as.matrix(phiPrimeB(object)[marker.index, batch.index])

 	if(enough.males){

 		res <- summarizeXGenotypes(marker.index=marker.index,

-					       batches=batches,

-					       object=object,

-					       GT.CONF.THR=GT.CONF.THR,

-					       MIN.SAMPLES=MIN.SAMPLES,

-					       MIN.OBS=MIN.OBS,

-					       verbose=verbose,

-					       is.lds=is.lds,

-					       DF.PRIOR=DF.PRIOR/2,

+					   batches=batches,

+					   object=object,

+					   GT.CONF.THR=GT.CONF.THR,

+					   MIN.SAMPLES=MIN.SAMPLES,

+					   MIN.OBS=MIN.OBS,

+					   verbose=verbose,

+					   is.lds=is.lds,

+					   DF.PRIOR=DF.PRIOR/2,

 					   gender="male")

 		madA.Mlist <- res[["madA"]]

 		madB.Mlist <- res[["madB"]]

@@ -855,6 +892,7 @@ fit.lm3 <- function(strata,

 	}

 	for(k in seq_along(batches)){

 		sample.index <- batches[[k]]

+		if(is.null(sample.index)) next()

 		this.batch <- unique(as.character(batch(object)[sample.index]))

 		gender <- object$gender[sample.index]

 		enough.men <- sum(gender==1) >= MIN.SAMPLES

@@ -878,6 +916,10 @@ fit.lm3 <- function(strata,

 			NN.M <- NN.Mlist[[k]]

 		}

 		if(enough.men & enough.women){

+			if(any(madA.F == 0)){

+				message("Zeros in median absolute deviation.  Not estimating CN for chrX for batch ", names(batches)[k])

+				next()

+			}

 			betas <- fit.wls(cbind(NN.M, NN.F),

 					 sigma=cbind(madA.M, madA.F),

 					 allele="A",

@@ -914,6 +956,10 @@ fit.lm3 <- function(strata,

 			phiB[, k] <- betas[2, ]

 		}

 		if(!enough.men & enough.women){

+			if(any(madA.F == 0)){

+				message("Zeros in median absolute deviation.  Not estimating CN for chrX for batch ", names(batches)[k])

+				next()

+			}

 			betas <- fit.wls(NN.F,

 					 sigma=madA.F,

 					 allele="A",

@@ -938,15 +984,16 @@ fit.lm3 <- function(strata,

 		phiB[phiB < MIN.PHI] <- MIN.PHI

 		phiB2[phiB2 < 1] <- 1

 	}

-	nuA(object)[marker.index, ] <- nuA

-	nuB(object)[marker.index, ] <- nuB

-	phiA(object)[marker.index, ] <- phiA

-	phiB(object)[marker.index, ] <- phiB

-	phiPrimeA(object)[marker.index, ] <- phiA2

-	phiPrimeB(object)[marker.index, ] <- phiB2

+	nuA(object)[marker.index, batch.index] <- nuA

+	nuB(object)[marker.index, batch.index] <- nuB

+	phiA(object)[marker.index, batch.index] <- phiA

+	phiB(object)[marker.index, batch.index] <- phiB

+	phiPrimeA(object)[marker.index, batch.index] <- phiA2

+	phiPrimeB(object)[marker.index, batch.index] <- phiB2

 	if(is.lds) {close(object); return(TRUE)} else return(object)

 }

+##nonpolymorphic markers on X

 fit.lm4 <- function(strata,

 		    index.list,

 		    object,

@@ -954,8 +1001,9 @@ fit.lm4 <- function(strata,

 		    THR.NU.PHI,

 		    MIN.NU,

 		    MIN.PHI,

-		    verbose, is.lds, ...){

-	if(is.lds) {physical <- get("physical"); open(object)}

+		    verbose, is.lds=TRUE, ...){

+	##if(is.lds) {physical <- get("physical"); open(object)}

+	## exclude batches that have fewer than MIN.SAMPLES

 	gender <- object$gender

 	enough.males <- sum(gender==1) >= MIN.SAMPLES

 	enough.females <- sum(gender==2) >= MIN.SAMPLES

@@ -963,68 +1011,71 @@ fit.lm4 <- function(strata,

 		message(paste("fewer than", MIN.SAMPLES, "men and women.  Copy number not estimated for CHR X"))

 		return(object)

 	}

+	excludeBatch <- names(table(batch(object)))[table(batch(object)) < MIN.SAMPLES]

+	if(length(excludeBatch) > 0){

+		bns <- unique(batch(object))

+		batch.index <- which(!bns %in% excludeBatch)

+		sample.index <- which(!batch(object)%in% excludeBatch)

+	} else {

+		sample.index <- 1:ncol(object)

+		batch.index <- as.integer(as.factor(unique(batch(object))))

+	}

 	if(verbose) message("      Probe stratum ", strata, " of ", length(index.list))

 	marker.index <- index.list[[strata]]

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

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

-	nc <- length(batchNames(object))

+	batches <- batches[batch.index]

+	nc <- length(batch.index)

 	if(enough.males){

 		res <- summarizeMaleXNps(marker.index=marker.index,

 					 batches=batches,

 					 object=object, MIN.SAMPLES=MIN.SAMPLES)

-		medianA.AA.M <- res[["medianA.AA"]]

-		madA.AA.M <- res[["madA.AA"]]

-

+		medianA.AA.M <- res[["medianA.AA"]][, batch.index, drop=FALSE]

+		madA.AA.M <- res[["madA.AA"]][, batch.index, drop=FALSE]

 	}

-	medianA.AA.F <- as.matrix(medianA.AA(object)[marker.index, ]) ## median for women

-	madA.AA.F <- as.matrix(madA.AA(object)[marker.index, ]) ## median for women

-	split.gender <- split(gender, as.character(batch(object)))

+	medianA.AA.F <- as.matrix(medianA.AA(object)[marker.index, batch.index, drop=FALSE]) ## median for women

+	madA.AA.F <- as.matrix(madA.AA(object)[marker.index, batch.index, drop=FALSE]) ## median for women

+	split.gender <- split(gender[sample.index], as.character(batch(object)[sample.index]))

 	N.M <- sapply(split.gender, function(x) sum(x==1))

 	N.F <- sapply(split.gender, function(x) sum(x==2))

-	nuA <- as.matrix(nuA(object)[marker.index, ])

-	nuB <- as.matrix(nuB(object)[marker.index, ])

-	phiA <- as.matrix(phiA(object)[marker.index, ])

-	phiB <- as.matrix(phiB(object)[marker.index, ])

+	nuA <- as.matrix(nuA(object)[marker.index, batch.index, drop=FALSE])

+	nuB <- as.matrix(nuB(object)[marker.index, batch.index, drop=FALSE])

+	phiA <- as.matrix(phiA(object)[marker.index, batch.index, drop=FALSE])

+	phiB <- as.matrix(phiB(object)[marker.index, batch.index, drop=FALSE])

 	ii <- isSnp(object) & chromosome(object) < 23 & !is.na(chromosome(object))

 	fns <- featureNames(object)[ii]

-	flags <- as.matrix(flags(object)[ii, ])

+	flags <- as.matrix(flags(object)[ii, batch.index])

 	fns.noflags <- fns[rowSums(flags, na.rm=T) == 0]

 	snp.index <- sample(match(fns.noflags, featureNames(object)), 10000)

-

-	## exclude batches that have fewer than MIN.SAMPLES

-	excludeBatch <- names(table(batch(object)))[table(batch(object)) < MIN.SAMPLES]

-	batch.index <- which(!batchNames(object) %in% excludeBatch)

-

+	##

 	N.AA <- as.matrix(N.AA(object)[snp.index, batch.index, drop=FALSE])

-	N.AB <- as.matrix(N.AA(object)[snp.index, batch.index, drop=FALSE])

-	N.BB <- as.matrix(N.AA(object)[snp.index, batch.index, drop=FALSE])

+	N.AB <- as.matrix(N.AB(object)[snp.index, batch.index, drop=FALSE])

+	N.BB <- as.matrix(N.BB(object)[snp.index, batch.index, drop=FALSE])

 	enoughAA <- rowSums(N.AA < 5) == 0

 	enoughAB <- rowSums(N.AB < 5) == 0

 	enoughBB <- rowSums(N.BB < 5) == 0

 	snp.index <- snp.index[enoughAA & enoughAB & enoughBB]

-	if(length(snp.index) < 100) {

-		message("Too few passing SNPs for estimating model parameters at nonpolymorphic loci on chrom X")

-		return()

+	if(length(snp.index) < 100){

+		message("too few snps pass criteria for estimating parameters for NP markers on chr X")

+		return(object)

 	}

-	##stopifnot(length(snp.index) > 100)

-	nuA.snp.notmissing <- rowSums(is.na(as.matrix(nuA(object)[snp.index, ]))) == 0

-	nuA.snp.notnegative <- rowSums(as.matrix(nuA(object)[snp.index, ]) < 20) == 0

+	nuA.snp <- as.matrix(nuA(object)[snp.index, batch.index, drop=FALSE])

+	nuA.snp.notmissing <- rowSums(is.na(nuA.snp)) == 0

+	nuA.snp.notnegative <- rowSums(as.matrix(nuA(object)[snp.index, batch.index, drop=FALSE]) < 20) == 0

 	snp.index <- snp.index[nuA.snp.notmissing & nuA.snp.notnegative]

-	medianA.AA.snp <- as.matrix(medianA.AA(object)[snp.index,])

-	medianB.BB.snp <- as.matrix(medianB.BB(object)[snp.index,])

-

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

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

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

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

+	medianA.AA.snp <- as.matrix(medianA.AA(object)[snp.index, batch.index])

+	medianB.BB.snp <- as.matrix(medianB.BB(object)[snp.index, batch.index])

+	nuA.snp <- as.matrix(nuA(object)[snp.index, batch.index])

+	nuB.snp <- as.matrix(nuB(object)[snp.index, batch.index])

+	phiA.snp <- as.matrix(phiA(object)[snp.index, batch.index])

+	phiB.snp <- as.matrix(phiB(object)[snp.index, batch.index])

 ##	pseudoAR <- position(object)[snp.index] < 2709520 | (position(object)[snp.index] > 154584237 & position(object)[snp.index] < 154913754)

 ##	pseudoAR[is.na(pseudoAR)] <- FALSE

 	for(k in seq_along(batches)){

 		B <- batches[[k]]

 		this.batch <- unique(as.character(batch(object)[B]))

 		gender <- object$gender[B]

-		enough.men <- N.M[k] >= MIN.SAMPLES

-		enough.women <- N.F[k] >= MIN.SAMPLES

+		enough.men <- N.M[[this.batch]] >= MIN.SAMPLES

+		enough.women <- N.F[[this.batch]] >= MIN.SAMPLES

 		if(!enough.men & !enough.women) {

 			if(verbose) message(paste("fewer than", MIN.SAMPLES, "men and women in batch", this.batch, ". CHR X copy number not available. "))

 			next()

@@ -1036,6 +1087,9 @@ fit.lm4 <- function(strata,

 		}

 		X <- cbind(1, log2(c(tmp[, 1], tmp[, 2])))

 		Y <- log2(c(tmp[, 3], tmp[, 4]))

+		notmissing.index <- which(rowSums(is.na(X)) == 0 & !is.na(Y))

+		X <- X[notmissing.index, ]

+		Y <- Y[notmissing.index]

 		betahat <- solve(crossprod(X), crossprod(X, Y))

 		if(enough.men){

 			X.men <- cbind(1, log2(medianA.AA.M[, k]))

@@ -1055,11 +1109,12 @@ fit.lm4 <- function(strata,

 		nuB[nuB < MIN.NU] <- MIN.NU

 		phiB[phiB < MIN.PHI] <- MIN.PHI

 	}

-	nuA(object)[marker.index, ] <- nuA

-	phiA(object)[marker.index, ] <- phiA

-	nuB(object)[marker.index, ] <- nuB

-	phiB(object)[marker.index, ] <- phiB

-	if(is.lds) {close(object); return(TRUE)} else return(object)

+	nuA(object)[marker.index, batch.index] <- nuA

+	phiA(object)[marker.index, batch.index] <- phiA

+	nuB(object)[marker.index, batch.index] <- nuB

+	phiB(object)[marker.index, batch.index] <- phiB

+	##if(is.lds) {close(object); return(TRUE)} else return(object)

+	TRUE

 }

 whichPlatform <- function(cdfName){

@@ -1411,18 +1466,12 @@ shrinkSummary <- function(object,

 }

 genotypeSummary <- function(object,

-			    GT.CONF.THR=0.95,

+			    GT.CONF.THR=0.80,

 			    type=c("SNP", "NP", "X.SNP", "X.NP"), ##"X.snps", "X.nps"),

 			    verbose=TRUE,

 			    marker.index,

 			    is.lds){

 	if(type == "X.SNP" | type=="X.NP"){

-##		gender <- object$gender

-##		## the number of women in each batch could be less than 3...

-##		if(sum(gender == 2) < 3) {

-##			message("too few females to estimate within genotype summary statistics on CHR X")

-##			return(object)

-##		}

 		CHR.X <- TRUE

 	} else CHR.X <- FALSE

 	if(missing(marker.index)){

@@ -1514,7 +1563,7 @@ summarizeNps <- function(strata, index.list, object, batchSize,

 		}

 		this.batch <- unique(as.character(batch(object)[sample.index]))

 		j <- match(this.batch, batchnames)

-		I.A <- AA[, sample.index]

+		I.A <- AA[, sample.index, drop=FALSE]

 		medianA.AA[, k] <- rowMedians(I.A, na.rm=TRUE)

 		madA.AA[, k] <- rowMAD(I.A, na.rm=TRUE)

 		## log2 Transform Intensities

@@ -1532,23 +1581,14 @@ summarizeSnps <- function(strata,

 			  index.list,

 			  object,

 			  GT.CONF.THR,

-			  verbose, is.lds, CHR.X, ...){

-	if(is.lds) {

-		physical <- get("physical")

-		open(object)

-	}

+			  verbose, is.lds=TRUE, CHR.X, ...){

+##	if(is.lds) {

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

+##		open(object)

+##	}

+	open(object)

 	if(verbose) message("      Probe stratum ", strata, " of ", length(index.list))

 	index <- index.list[[strata]]

-##	if(CHR.X) {

-##		sample.index <- which(object$gender==2)

-##		batches <- split(sample.index, as.character(batch(object))[sample.index])

-##	} else {

-##		batches <- split(seq_along(batch(object)), as.character(batch(object)))

-##	}

-	## this message can be confusing if no women are in the dataset

-##	if(CHR.X){

-##		if(verbose) message("        biallelic cluster medians are estimated using only the women for SNPs on chr. X")

-##	}

 	batches <- split(seq_along(batch(object)), as.character(batch(object)))

 	batchnames <- batchNames(object)

 	nr <- length(index)

@@ -1562,6 +1602,14 @@ summarizeSnps <- function(strata,

 	AA <- as.matrix(A(object)[index, ])

 	BB <- as.matrix(B(object)[index, ])

 	FL <- as.matrix(flags(object)[index, ])

+	summaryStats <- function(X, INT, FUNS){

+		tmp <- matrix(NA, nrow(X), length(FUNS))

+		for(j in seq_along(FUNS)){

+			FUN <- match.fun(FUNS[j])

+			tmp[, j] <- FUN(X*INT, na.rm=TRUE)

+		}

+		tmp

+	}

 	if(verbose) message("        Computing summaries...")

 	for(k in seq_along(batches)){

 		##note that the genotype frequency for AA would include 'A' on chromosome X for men

@@ -1569,10 +1617,17 @@ summarizeSnps <- function(strata,

 		this.batch <- unique(as.character(batch(object)[sample.index]))

 		j <- match(this.batch, batchnames)

 		G <- GG[, sample.index, drop=FALSE]

-		##NORM <- normal.index[, k]

 		xx <- CP[, sample.index, drop=FALSE]

 		highConf <- (1-exp(-xx/1000)) > GT.CONF.THR

+		## Some markers may have genotype confidences scores that are ALL below the threshold

+		## For these markers, provide statistical summaries based on all the samples and flag

+		## Provide summaries for these markers and flag to indicate the problem

+		## RS: check whether we need the next to lines and, if so, effect downstream

+		ii <- which(rowSums(highConf) == 0)

+		if(length(ii) > 0) highConf[ii, ] <- TRUE

 		G <- G*highConf

+		## table(rowSums(G==0))

+		##G <- G*highConf*NORM

 		A <- AA[, sample.index, drop=FALSE]

 		B <- BB[, sample.index, drop=FALSE]

 		## this can be time consuming...do only once

@@ -1590,48 +1645,101 @@ summarizeSnps <- function(strata,

 			sample.index <- sample.index[gender == 2]

 			if(length(sample.index) == 0) next()

 		}

-		summaryStats <- function(X, INT, FUNS){

-			tmp <- matrix(NA, nrow(X), length(FUNS))

-			for(j in seq_along(FUNS)){