@@ -10,7 +10,7 @@ License: Artistic-2.0

 Depends: R (>= 2.11.0),

          methods,

          Biobase (>= 2.9.0),

-         oligoClasses (>= 1.11.6)

+         oligoClasses (>= 1.11.7)

 Imports: affyio (>= 1.15.2),

          ellipse,

          ff,

@@ -27,6 +27,7 @@ Suggests: hapmapsnp6,

 	  ellipse

 Collate: AllGenerics.R

 	 AllClasses.R

+	 methods-AssayData.R

 	 methods-CNSet.R

 	 methods-eSet.R

          methods-SnpSuperSet.R

@@ -29,7 +29,9 @@ importClassesFrom(oligoClasses, SnpSuperSet, AlleleSet, CNSet)

 importMethodsFrom(oligoClasses, allele, calls, "calls<-", confs,

 		  "confs<-", cnConfidence, "cnConfidence<-", isSnp,

 		  chromosome, position, A, B,

-		  "A<-", "B<-", open, close, lM, "lM<-", flags)

+		  "A<-", "B<-", open, close, lM, flags,

+		  batchStatistics, "batchStatistics<-", updateObject)

+

 importFrom(oligoClasses, chromosome2integer, celfileDate, list.celfiles,

            copyNumber, initializeBigMatrix, initializeBigVector)

@@ -55,7 +57,7 @@ importFrom(mvtnorm, dmvnorm)

 importFrom(ellipse, ellipse)

 importFrom(ff, ffdf, physical.ff, physical.ffdf)

-importClassesFrom(oligoClasses, ffdf)

+importClassesFrom(oligoClasses, ffdf, ff_matrix)

 exportMethods(lines)

 exportMethods(CA, CB)

@@ -79,8 +81,12 @@ export(computeCopynumber, ACN)

 export(totalCopyNumber)

 export(cnrma, cnrma2)

-exportMethods("A<-", "B<-", "nuA", "nuB", "phiA", "phiB", "nuA<-", "nuB<-", "phiA<-", "phiB<-", "numberGenotype<-")

-

+exportMethods("A<-", "B<-", "nuA", "nuB", "phiA", "phiB", "nuA<-", "nuB<-", "phiA<-", "phiB<-")

+exportMethods(Ns, medians, mads, tau2, corr)

+exportClasses(ff_or_matrix)

+export(genotypeSummary, summarizeSnps, summarizeNps, shrinkSummary, shrinkGenotypeSummaries, summarizeMaleXGenotypes,

+       indexComplete)

+export(Ns)

 ## For debugging

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

@@ -12,19 +12,84 @@ setGeneric("CB", function(object, ...) standardGeneric("CB"))

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

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

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

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

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

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

+

 ## The generics below are for internal use with copy number methods

 ## If we keep them in oligoClasses, we need to export and document

+setGeneric("N.AA", function(object) standardGeneric("N.AA"))

+setGeneric("N.AB", function(object) standardGeneric("N.AB"))

+setGeneric("N.BB", function(object) standardGeneric("N.BB"))

+setGeneric("N.AA<-", function(object, value) standardGeneric("N.AA<-"))

+setGeneric("N.AB<-", function(object, value) standardGeneric("N.AB<-"))

+setGeneric("N.BB<-", function(object, value) standardGeneric("N.BB<-"))

+

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

+setGeneric("medianA.AA", function(object) standardGeneric("medianA.AA"))

+setGeneric("medianA.AB", function(object) standardGeneric("medianA.AB"))

+setGeneric("medianA.BB", function(object) standardGeneric("medianA.BB"))

+setGeneric("medianB.AA", function(object) standardGeneric("medianB.AA"))

+setGeneric("medianB.AB", function(object) standardGeneric("medianB.AB"))

+setGeneric("medianB.BB", function(object) standardGeneric("medianB.BB"))

+setGeneric("medianA.AA<-", function(object, value) standardGeneric("medianA.AA<-"))

+setGeneric("medianA.AB<-", function(object, value) standardGeneric("medianA.AB<-"))

+setGeneric("medianA.BB<-", function(object, value) standardGeneric("medianA.BB<-"))

+setGeneric("medianB.AA<-", function(object, value) standardGeneric("medianB.AA<-"))

+setGeneric("medianB.AB<-", function(object, value) standardGeneric("medianB.AB<-"))

+setGeneric("medianB.BB<-", function(object, value) standardGeneric("medianB.BB<-"))

+

+

+

+setGeneric("madA.AA", function(object) standardGeneric("madA.AA"))

+setGeneric("madA.AB", function(object) standardGeneric("madA.AB"))

+setGeneric("madA.BB", function(object) standardGeneric("madA.BB"))

+setGeneric("madB.AA", function(object) standardGeneric("madB.AA"))

+setGeneric("madB.AB", function(object) standardGeneric("madB.AB"))

+setGeneric("madB.BB", function(object) standardGeneric("madB.BB"))

+setGeneric("madA.AA<-", function(object, value) standardGeneric("madA.AA<-"))

+setGeneric("madA.AB<-", function(object, value) standardGeneric("madA.AB<-"))

+setGeneric("madA.BB<-", function(object, value) standardGeneric("madA.BB<-"))

+setGeneric("madB.AA<-", function(object, value) standardGeneric("madB.AA<-"))

+setGeneric("madB.AB<-", function(object, value) standardGeneric("madB.AB<-"))

+setGeneric("madB.BB<-", function(object, value) standardGeneric("madB.BB<-"))

+

+setGeneric("tau2A.AA", function(object) standardGeneric("tau2A.AA"))

+##setGeneric("tau2A.AB", function(object) standardGeneric("tau2A.AB"))

+setGeneric("tau2A.BB", function(object) standardGeneric("tau2A.BB"))

+setGeneric("tau2B.AA", function(object) standardGeneric("tau2B.AA"))

+##setGeneric("tau2B.AB", function(object) standardGeneric("tau2B.AB"))

+setGeneric("tau2B.BB", function(object) standardGeneric("tau2B.BB"))

+setGeneric("tau2A.AA<-", function(object, value) standardGeneric("tau2A.AA<-"))

+##setGeneric("tau2A.AB<-", function(object, value) standardGeneric("tau2A.AB<-"))

+setGeneric("tau2A.BB<-", function(object, value) standardGeneric("tau2A.BB<-"))

+setGeneric("tau2B.AA<-", function(object, value) standardGeneric("tau2B.AA<-"))

+##setGeneric("tau2B.AB<-", function(object, value) standardGeneric("tau2B.AB<-"))

+setGeneric("tau2B.BB<-", function(object, value) standardGeneric("tau2B.BB<-"))

+

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

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

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

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

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

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

+

+

+

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

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

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

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

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

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

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

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

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

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

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

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

-setGeneric("corrAA", function(object) standardGeneric("corrAA"))

-setGeneric("corrBB", function(object) standardGeneric("corrBB"))

-setGeneric("corrAB", function(object) standardGeneric("corrAB"))

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

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

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

@@ -33,11 +98,6 @@ setGeneric("sigma2A<-", function(object, value) standardGeneric("sigma2A<-"))

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

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

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

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

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

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

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

-setGeneric("numberGenotype<-", function(object, value, ...) standardGeneric("numberGenotype<-"))

-

@@ -362,13 +362,13 @@ rowCors <- function(x, y, ...){

 	return(covar/(sd.x*sd.y))

 }

-corByGenotype <- function(A, B, G, Ns, which.cluster=c(1,2,3)[1], DF.PRIOR){

+corByGenotype <- function(A, B, G, Ns, which.cluster=c(1,2,3)[1]){##, DF.PRIOR){

 	x <- A * (G == which.cluster)

 	x[x==0] <- NA

 	y <- B * (G == which.cluster)

 	res <- as.matrix(rowCors(x, y, na.rm=TRUE))

-	cors <- shrink(res, Ns[, which.cluster], DF.PRIOR)

-	cors

+##	cors <- shrink(res, Ns[, which.cluster], DF.PRIOR)

+	res

 }

 dqrlsWrapper <- function(x, y, wts, tol=1e-7){

@@ -382,24 +382,38 @@ dqrlsWrapper <- function(x, y, wts, tol=1e-7){

 		 work=double(2 * p), PACKAGE="base")[["coefficients"]]

 }

-fit.wls <- function(allele, Ystar, W, Ns, autosome=TRUE){

+

+##fit.wls <- function(allele, Ystar, W, Ns, autosome=TRUE){

+fit.wls <- function(NN, sigma, allele, Y, autosome, X){

+	##		Np <- NN

+##		Np[Np < 1] <- 1

+##		vA2 <- vA^2/Np

+##		vB2 <- vB^2/Np

+##		wA <- sqrt(1/vA2)

+##		wB <- sqrt(1/vB2)

+##		YA <- muA*wA

+##		YB <- muB*wB

+	Np <- NN

+	Np[Np < 1] <- 1

+	W <- (sigma/sqrt(Np))^-1

+	Ystar <- Y*W

 	complete <- which(rowSums(is.na(W)) == 0 & rowSums(is.na(Ystar)) == 0)

 ##	if(any(!is.finite(W))){## | any(!is.finite(V))){

 ##		i <- which(rowSums(!is.finite(W)) > 0)

 ##		stop("Possible zeros in the within-genotype estimates of the spread (vA, vB). ")

 ##	}

-	NOHET <- mean(Ns[, 2], na.rm=TRUE) < 0.05

+##	NOHET <- mean(NN[, 2], na.rm=TRUE) < 0.05

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

-	if(autosome){

+	if(autosome & missing(X)){

 		if(allele == "A") X <- cbind(1, 2:0)

 		if(allele == "B") X <- cbind(1, 0:2)

-		betahat <- matrix(NA, 2, nrow(Ystar))

-	} else {

+	}

+	if(!autosome & missing(X)){

 		if(allele == "A") X <- cbind(1, c(1, 0, 2, 1, 0), c(0, 1, 0, 1, 2))

 		if(allele == "B") X <- cbind(1, c(0, 1, 0, 1, 2), c(1, 0, 2, 1, 0))

-		betahat <- matrix(NA, 3, nrow(Ystar))

 	}

-	if(NOHET) X <- X[-2, ] ##more than 1 X chromosome, but all homozygous

+	betahat <- matrix(NA, ncol(X), nrow(Ystar))

+##	if(NOHET) X <- X[-2, ] ##more than 1 X chromosome, but all homozygous

 	##How to quickly generate Xstar, Xstar = diag(W) %*% X

 	##Xstar <- apply(W, 1, generateX, X)

 	ww <- rep(1, ncol(Ystar))

@@ -780,11 +794,136 @@ crlmmCopynumberLD <- function(object,

 }

 crlmmCopynumber2 <- crlmmCopynumberLD

-fit.lm1 <- function(strata.index,

+

+

+

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

+				    verbose, is.lds){

+	if(is.lds) {physical <- get("physical"); 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, ])

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

+		B <- batches[[k]]

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

+

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

+		medianB[[k]] <- 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])

+		##RS: estimate DF.PRIOR

+		shrink.madA[[k]] <- shrink(madA, NN, DF.PRIOR)

+		shrink.madB[[k]] <- shrink(madB, NN, DF.PRIOR)

+

+		## an estimate of the background variance is the MAD

+		## of the log2(allele A) intensities among subjects with

+		## genotypes BB

+		shrink.tau2A.BB[, k] <- shrink(tau2A.BB[, k, drop=FALSE], NN[, 3], DF.PRIOR)[, drop=FALSE]

+		shrink.tau2B.AA[, k] <- shrink(tau2B.AA[, k, drop=FALSE], NN[, 1], DF.PRIOR)[, drop=FALSE]

+		## an estimate of the signal variance is the MAD

+		## of the log2(allele A) intensities among subjects with

+		## genotypes AA

+		shrink.tau2A.AA[, k] <- shrink(tau2A.AA[, k, drop=FALSE], NN[, 1], DF.PRIOR)[, drop=FALSE]

+		shrink.tau2B.BB[, k] <- shrink(tau2B.BB[, k, drop=FALSE], NN[, 3], DF.PRIOR)[, drop=FALSE]

+		cor.AA <- corrAA[, k, drop=FALSE]

+		cor.AB <- corrAB[, k, drop=FALSE]

+		cor.BB <- corrBB[, k, drop=FALSE]

+		shrink.corrAA[, k] <- shrink(cor.AA, NN[, 1], DF.PRIOR)

+		shrink.corrAB[, k] <- shrink(cor.AB, NN[, 2], DF.PRIOR)

+		shrink.corrBB[, k] <- shrink(cor.BB, NN[, 3], DF.PRIOR)

+

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

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

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

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

+

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

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

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

+		unobservedAA <- NN[, 1] < MIN.OBS

+		unobservedAB <- NN[, 2] < MIN.OBS

+		unobservedBB <- NN[, 3] < MIN.OBS

+		unobserved.index <- vector("list", 3)

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

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

+		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]]

+		rm(res)

+		##the NA's in 'medianA' and 'medianB' are monomorphic if MIN.OBS = 1

+

+		## 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]]

+		rm(res)

+		negA <- rowSums(medianA[[k]] < 0) > 0

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

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

+	}

+	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]))

+

+	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]))

+

+	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

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

+}

+

+

+

+fit.lm1 <- function(strata,

 		    index.list,

-		    marker.index,

 		    object,

-		    batchSize,

 		    SNRMin,

 		    MIN.SAMPLES,

 		    MIN.OBS,

@@ -793,142 +932,63 @@ fit.lm1 <- function(strata.index,

 		    THR.NU.PHI,

 		    MIN.NU,

 		    MIN.PHI,

-		    verbose,...){

-	if(isPackageLoaded("ff")) physical <- get("physical")

-	is.lds <- ifelse(is(calls(object), "ffdf") | is(calls(object), "ff_matrix"), TRUE, FALSE)

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

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

-	batches <- split(seq_along(batch(object)), batch(object))

+		    verbose, is.lds,

+		    CHR.X, ...){

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

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

+	snps <- index.list[[strata]]

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

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

-	open(object)

-	corrAB <- corrBB <- corrAA <- sig2B <- sig2A <- tau2B <- tau2A <- matrix(NA, length(snps), length(unique(batch(object))))

-	flags <- nuA <- nuB <- phiA <- phiB <- corrAB

-	## should the 'normal' indicator

-	NORM <- 1

-

-	Ns.names <- ls(numberGenotype(object))

 	batchnames <- batchNames(object)

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

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

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

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

-	zzzz <- 1

-	for(k in batches){

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

-		zzzz <- zzzz+1

-		G <- GG[, k]

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

-		xx <- CP[, k]

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

-		G <- G*highConf*NORM

-		A <- AA[, k]

-		B <- BB[, k]

-		##index <- GT.B <- GT.A <- vector("list", 3)

-		##names(index) <- names(GT.B) <- names(GT.A) <- c("AA", "AB", "BB")

-		Ns <- applyByGenotype(matrix(1, nrow(G), ncol(G)), rowSums, G)

-		muA <- applyByGenotype(A, rowMedians, G)

-		muB <- applyByGenotype(B, rowMedians, G)

-		vA <- applyByGenotype(A, rowMAD, G)

-		vB <- applyByGenotype(B, rowMAD, G)

-		vA <- shrink(vA, Ns, DF.PRIOR)

-		vB <- shrink(vB, Ns, DF.PRIOR)

-		##location and scale

-		J <- match(unique(batch(object)[k]), batchnames)##unique(batch(object)))

-		##background variance for alleleA

-		taus <- applyByGenotype(log2(A), rowMAD, G)^2

-		tau2A[, J] <- shrink(taus[, 3, drop=FALSE], Ns[, 3], DF.PRIOR)

-		sig2A[, J] <- shrink(taus[, 1, drop=FALSE], Ns[, 1], DF.PRIOR)

-		taus <- applyByGenotype(log2(B), rowMAD, G)^2

-		tau2B[, J] <- shrink(taus[, 3, drop=FALSE], Ns[, 1], DF.PRIOR)

-		sig2B[, J] <- shrink(taus[, 1, drop=FALSE], Ns[, 3], DF.PRIOR)

-

-		corrAB[, J] <- corByGenotype(A=A, B=B, G=G, Ns=Ns, which.cluster=2, DF.PRIOR)

-		corrAA[, J] <- corByGenotype(A=A, B=B, G=G, Ns=Ns, which.cluster=1, DF.PRIOR)

-		corrBB[, J] <- corByGenotype(A=A, B=B, G=G, Ns=Ns, which.cluster=3, DF.PRIOR)

-

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

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

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

-		index <- apply(Ns, 2, function(x, MIN.OBS) which(x > MIN.OBS), MIN.OBS)

-		correct.orderA <- muA[, 1] > muA[, 3]

-		correct.orderB <- muB[, 3] > muB[, 1]

-		index.complete <- intersect(which(correct.orderA & correct.orderB), intersect(index[[1]], intersect(index[[2]], index[[3]])))

-		size <- min(5000, length(index.complete))

-		if(size == 5000) index.complete <- sample(index.complete, 5000, replace=TRUE)

-		if(length(index.complete) < 200){

-			warning("fewer than 200 snps pass criteria for predicting the sufficient statistics")

-			return()

-		}

-		index <- vector("list", 3)

-		index[[1]] <- which(Ns[, 1] == 0 & (Ns[, 2] >= MIN.OBS & Ns[, 3] >= MIN.OBS))

-		index[[2]] <- which(Ns[, 2] == 0 & (Ns[, 1] >= MIN.OBS & Ns[, 3] >= MIN.OBS))

-		index[[3]] <- which(Ns[, 3] == 0 & (Ns[, 2] >= MIN.OBS & Ns[, 1] >= MIN.OBS))

-		res <- imputeCenter(muA, muB, index.complete, index)

-		muA <- res[[1]]

-		muB <- res[[2]]

-

-		## Monomorphic SNPs.  Mixture model may be better

-		## Improve estimation by borrowing strength across batch

-		noAA <- Ns[, 1] < MIN.OBS

-		noAB <- Ns[, 2] < MIN.OBS

-		noBB <- Ns[, 3] < MIN.OBS

-		index[[1]] <- noAA & noAB

-		index[[2]] <- noBB & noAB

-		index[[3]] <- noAA & noBB

-		cols <- c(3, 1, 2)

-		for(j in 1:3){

-			if(sum(index[[j]]) == 0) next()

-			kk <- cols[j]

-			X <- cbind(1, muA[index.complete, kk], muB[index.complete, kk])

-			Y <- cbind(muA[index.complete,  -kk],

-				   muB[index.complete,  -kk])

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

-			X <- cbind(1, muA[index[[j]],  kk], muB[index[[j]],  kk])

-			mus <- X %*% betahat

-			muA[index[[j]], -kk] <- mus[, 1:2]

-			muB[index[[j]], -kk] <- mus[, 3:4]

-		}

-		rm(betahat, X, Y, mus, index, noAA, noAB, noBB, res)

-		##gc()

-		negA <- rowSums(muA < 0) > 0

-		negB <- rowSums(muB < 0) > 0

-		flags[, J] <- rowSums(Ns == 0) > 0

-		##flags[, J] <- index[[1]] | index[[2]] | index[[3]] | rowSums(

+	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, ])

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

+		B <- batches[[k]]

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

+		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])

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

-		##formerly coefs()

-		Np <- Ns

-		Np[Np < 1] <- 1

-		vA2 <- vA^2/Np

-		vB2 <- vB^2/Np

-		wA <- sqrt(1/vA2)

-		wB <- sqrt(1/vB2)

-		YA <- muA*wA

-		YB <- muB*wB

-		res <- fit.wls(allele="A", Ystar=YA, W=wA, Ns=Ns)

-##		} else{

-##			if(zzzz==1) message("currently, only weighted least squares (wls) is available... fitting wls")

-##			res <- fit.wls(allele="A", Ystar=YA, W=wA, Ns=Ns)

-##		}

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

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

-		res <- fit.wls(allele="B", Ystar=YB, W=wB, Ns=Ns)

-##		} else {

-##			if(zzzz==1) message("currently, only weighted least squares (wls) is available... fitting wls")

-##			res <- fit.wls(allele="B", Ystar=YB, W=wB, Ns=Ns)

-##		}

-		##nuB[, J] <- res[[1]]

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

-		##phiB[, J] <- res[[2]]

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

+		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(allele="A", Ystar=YA, W=wA, Ns=Ns)

+		##nuA[, J] <- res[[1]]

+		##phiA[, J] <- res[[2]]

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

-		jj <- match(this.batch, Ns.names)

-		numberGenotype(object, this.batch)[snps, ] <- Ns

-		rm(G, A, B, wA, wB, YA,YB, res, negA, negB, Np, Ns)

-		##gc()

 	}

-	nGt <- lapply(nGt, function(x){ colnames(x) <- c("AA", "AB", "BB"); return(x)})

-

 	if(THR.NU.PHI){

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

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

@@ -943,34 +1003,21 @@ fit.lm1 <- function(strata.index,

 ##	cB <- matrix(as.integer(cB*100), nrow(cB), ncol(cB))

 ##	CA(object)[snps, ] <- cA

 ##	CB(object)[snps, ] <- cB

-	if(is.lds) lapply(lM(object), open)

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

-	tau2A(object) <- tau2A

-	tau2B(object) <- tau2B

-	sigma2A(object) <- sig2A

-	sigma2B(object) <- sig2B

-	nuA(object) <- nuA

-	nuB(object) <- nuB

-	phiA(object) <- phiA

-	phiB(object) <- phiB

-	corrAA(object) <- corrAA

-	corrBB(object) <- corrBB

-	corrAB(object) <- corrAB

-	if(is.lds) {

-		lapply(assayData(object), close)

-		lapply(lM(object), close)

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

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

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

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

+	if(is.lds){

+		close(object)

 		return(TRUE)

 	} else{

 		return(object)

 	}

 }

-fit.lm2 <- function(strata.index,

+fit.lm2 <- function(strata,

 		    index.list,

-		    marker.index,

 		    object,

-		    Ns,

-		    batchSize,

 		    SNRMin,

 		    MIN.SAMPLES,

 		    MIN.OBS,

@@ -979,107 +1026,238 @@ fit.lm2 <- function(strata.index,

 		    THR.NU.PHI,

 		    MIN.NU,

 		    MIN.PHI,

-		    verbose,...){

-	physical <- get("physical")

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

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

-	batches <- split(seq(along=batch(object)), batch(object))

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

+	if(is.lds) {physical <- get("physical"); 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]

-	open(object)

-	open(snpflags)

-##	open(normal)

-##	cA <- matrix(NA, length(snps), ncol(object))

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

-	flags <- as.matrix(snpflags[,])

-	noflags <- rowSums(flags, na.rm=TRUE) == 0  ##NA's for unevaluated batches

-	## We do not want to write to discuss for each batch.  More efficient to

-	## write to disk after estimating these parameters for all batches.

-	nuA.np <- phiA.np <- sig2A.np <- matrix(NA, length(snps), length(unique(batch(object))))

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

+	fns <- featureNames(object)[ii]

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

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

+

+	##flags <- as.matrix(snpflags[,])

+	##noflags <- rowSums(flags, na.rm=TRUE) == 0  ##NA's for unevaluated batches

+

+	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.np <- phiA.np <- sig2A.np <- matrix(NA, length(marker.index), length(unique(batch(object))))

 	## for imputation, we need the corresponding parameters of the snps

-	NN <- min(10e3, length(which(ii & noflags)))

-	snp.ind <- sample(which(ii & noflags), NN)

-	nnuA.snp <- as.matrix(physical(lM(object))$nuA[snp.ind,])

-	pphiA.snp <- as.matrix(physical(lM(object))$phiA[snp.ind,])

-	nnuB.snp <- as.matrix(physical(lM(object))$nuB[snp.ind,])

-	pphiB.snp <- as.matrix(physical(lM(object))$phiB[snp.ind,])

-

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

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

+	##NN <- min(10e3, length(which(ii & noflags)))

+	##snp.ind <- sample(which(ii & noflags), NN)

+	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,])

+

+##	nnuA.snp <- as.matrix(physical(lM(object))$nuA[snp.ind,])

+##	pphiA.snp <- as.matrix(physical(lM(object))$phiA[snp.ind,])

+##	nnuB.snp <- as.matrix(physical(lM(object))$nuB[snp.ind,])

+##	pphiB.snp <- as.matrix(physical(lM(object))$phiB[snp.ind,])

+

+##	AA.snp <- as.matrix(A(object)[snp.ind, ])

+##	BB.snp <- as.matrix(B(object)[snp.ind, ])

 ##	NNORM.snp <- as.matrix(normal[snp.ind, ])

 ##	NORM.np <- as.matrix(normal[snps, ])

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

-	GG <- as.matrix(calls(object)[snp.ind, ])

-	CP <- as.matrix(snpCallProbability(object)[snp.ind, ])

-	for(k in batches){

-		##if(verbose) message("SNP batch ", ii, " of ", length(batches))

-		J <- match(unique(batch(object)[k]), unique(batch(object)))

-##		snp.index <- snp.ind & nuA[, J] > 20 & nuB[, J] > 20 & phiA[, J] > 20 & phiB[, J] > 20

-##		if(sum(snp.index) >= 5000){

-##			snp.index <- sample(which(snp.index), 5000)

-##		} else snp.index <- which(snp.index)

-		phiA.snp <- pphiA.snp[, J]

-		phiB.snp <- pphiB.snp[, J]

-		A.snp <- AA.snp[, k]

-		B.snp <- BB.snp[, k]

-		NORM.snp <- NNORM.snp[, k]

-		G <- GG[, k]

-		xx <- CP[, k]

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

-		G <- G*highConf*NORM.snp

-		G[G==0] <- NA

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

+##	GG <- as.matrix(calls(object)[snp.ind, ])

+##	CP <- as.matrix(snpCallProbability(object)[snp.ind, ])

+	for(k in seq_along(batches)){

+		B <- batches[[k]]

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

+##		phiA.snp <- pphiA.snp[, J]

+##		phiB.snp <- pphiB.snp[, J]

+##		A.snp <- AA.snp[, k]

+##		B.snp <- BB.snp[, k]

+##		NORM.snp <- NNORM.snp[, k]

+##		G <- GG[, k]

+##		xx <- CP[, k]

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

+##		G <- G*highConf*NORM.snp

+##		G[G==0] <- NA

 		##nonpolymorphic

-		A.np <- AA.np[, k]

-		Ns <- applyByGenotype(matrix(1, nrow(G), ncol(G)), rowSums, G)

-		muA <- applyByGenotype(A.snp, rowMedians, G)

-		muB <- applyByGenotype(B.snp, rowMedians, G)

-		muA <- muA[, 1]

-		muB <- muB[, 3]

-		X <- cbind(1, log2(c(muA, muB)))

+##		A.np <- AA.np[, k]

+##		Ns <- applyByGenotype(matrix(1, nrow(G), ncol(G)), rowSums, G)

+##		muA <- applyByGenotype(A.snp, rowMedians, G)

+##		muB <- applyByGenotype(B.snp, rowMedians, G)

+##		muA <- muA[, 1]

+##		muB <- muB[, 3]

+##		X <- cbind(1, log2(c(muA, muB)))

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

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

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

 		##

-		mus <- rowMedians(A.np * NORM.np[, k], na.rm=TRUE)

-		crosshyb <- max(median(muA) - median(mus), 0)

-		X <- cbind(1, log2(mus+crosshyb))

+##		mus <- rowMedians(A.np * NORM.np[, k], na.rm=TRUE)

+##		averaging across markers, is there a difference in the

+##		typical AA intensity for SNPs and the AA intensity for

+##		nonpolymorphic loci

+##		crosshyb <- max(median(muA) - median(mus), 0)

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

+##		X <- cbind(1, log2(mus+crosshyb))

+		X <- cbind(1, log2(medianA.AA.np[, k] + crosshyb))

 		logPhiT <- X %*% betahat

-		phiA.np[, J] <- 2^(logPhiT)

-		nuA.np[, J] <- mus-2*phiA.np[, J]

-		if(THR.NU.PHI){

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

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

-		}

+		phiA.np[, k] <- 2^(logPhiT)

+		nuA.np[, k] <- medianA.AA.np[,k]-2*phiA.np[, k]

 ##		cA[, k] <- 1/phiA.np[, J] * (A.np - nuA.np[, J])

-		sig2A.np[, J] <- rowMAD(log2(A.np*NORM.np[, k]), na.rm=TRUE)

-		rm(NORM.snp, highConf, xx, G, Ns, A.np, X, Y, betahat, mus, logPhiT)

-		gc()

+##		sig2A.np[, J] <- rowMAD(log2(A.np*NORM.np[, k]), na.rm=TRUE)

+##		rm(NORM.snp, highConf, xx, G, Ns, A.np, X, Y, betahat, mus, logPhiT)

+##		gc()

+	}

+	if(THR.NU.PHI){

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

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

 	}

 ##	cA[cA < 0.05] <- 0.05

 ##	cA[cA > 5] <-  5

 ##	cA <- matrix(as.integer(cA*100), nrow(cA), ncol(cA))

-##	CA(object)[snps, ] <- cA

-	tmp <- physical(lM(object))$nuA

-	tmp[snps, ] <- nuA.np

-	lM(object)$nuA <- tmp

-	tmp <- physical(lM(object))$sig2A

-	tmp[snps, ] <- sig2A.np

-	lM(object)$sig2A <- tmp

-	tmp <- physical(lM(object))$phiA

-	tmp[snps, ] <- phiA.np

-	lM(object)$sig2A <- tmp

-	lapply(assayData(object), close)

-	lapply(lM(object), close)

-	TRUE

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

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

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

+	return(object)

 }

+summarizeMaleXNps <- function(marker.index,

+			      batches,

+			      object, MIN.SAMPLES){

+	nr <- length(marker.index)

+	nc <- length(batchNames(object))

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

+	gender <- object$gender

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

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

+	numberMenPerBatch <- rep(NA, nc)

+	for(k in seq_along(batches)){

+		B <- batches[[k]]

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

+		gender <- object$gender[B]

+		if(sum(gender==1) < MIN.SAMPLES) next()

+		sns.batch <- sampleNames(object)[B]

+		##subset GG apppriately

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

+	}

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

+		    madA.AA=madA.AA))

+}

+

+

+summarizeMaleXGenotypes <- function(marker.index,

+				    batches,

+				    object,

+				    GT.CONF.THR,

+				    MIN.OBS,

+				    MIN.SAMPLES,

+				    verbose,

+				    is.lds,

+				    DF.PRIOR,...){

+	nr <- length(marker.index)

+	nc <- length(batchNames(object))

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

+	gender <- object$gender

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

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

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

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

+	for(k in seq_along(batches)){

+		B <- batches[[k]]

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

+		gender <- object$gender[B]

+		if(sum(gender==1) < MIN.SAMPLES) next()

+		sns.batch <- sampleNames(object)[B]

+		##subset GG apppriately

+		sns <- colnames(GG)

+		J <- sns%in%sns.batch

+		G <- GG[, J]

+		xx <- CP[, J]

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

+		G <- G*highConf

+		A <- AA[, J]

+		B <- BB[, J]

+		G.AA <- G==1

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

+		G.AB <- G==2

+		G.AB[G.AB==FALSE] <- NA

+		G.BB <- G==3

+		G.BB[G.BB==FALSE] <- NA

+		N.AA.M <- rowSums(G.AA, na.rm=TRUE)

+		N.AB.M <- rowSums(G.AB, na.rm=TRUE)

+		N.BB.M <- rowSums(G.BB, na.rm=TRUE)

+		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

+		}

+		statsA.AA <- summaryStats(G.AA, A, FUNS=c("rowMedians", "rowMAD"))

+		statsA.AB <- summaryStats(G.AB, A, FUNS=c("rowMedians", "rowMAD"))

+		statsA.BB <- summaryStats(G.BB, A, FUNS=c("rowMedians", "rowMAD"))

+		statsB.AA <- summaryStats(G.AA, B, FUNS=c("rowMedians", "rowMAD"))

+		statsB.AB <- summaryStats(G.AB, B, FUNS=c("rowMedians", "rowMAD"))

+		statsB.BB <- summaryStats(G.BB, B, FUNS=c("rowMedians", "rowMAD"))

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

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

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

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

+		rm(statsA.AA, statsA.AB, statsA.BB, statsB.AA, statsB.AB, statsB.BB)

+

+##		A <- log2(A); B <- log2(B)

+##		tau2A.AA <- summaryStats(G.AA, A, FUNS="rowMAD")^2

+##		tau2A.BB <- summaryStats(G.BB, A, FUNS="rowMAD")^2

+##		tau2B.AA <- summaryStats(G.AA, B, FUNS="rowMAD")^2

+##		tau2B.BB <- summaryStats(G.BB, B, FUNS="rowMAD")^2

+		##tau2A <- cbind(tau2A.AA, tau2A.BB)

+		##tau2B <- cbind(tau2B.AA, tau2B.BB)

+		NN.M <- cbind(N.AA.M, N.AB.M, N.BB.M)

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

+

+		shrink.madA[[k]] <- shrink(madA, NN.M, DF.PRIOR)

+		shrink.madB[[k]] <- shrink(madB, NN.M, DF.PRIOR)

+

+##		shrink.tau2A.BB[, k] <- shrink(tau2A.BB[, k, drop=FALSE], NN.M[, 3], DF.PRIOR)[, drop=FALSE]

+##		shrink.tau2B.AA[, k] <- shrink(tau2B.AA[, k, drop=FALSE], NN.M[, 1], DF.PRIOR)[, drop=FALSE]

+##		shrink.tau2A.AA[, k] <- shrink(tau2A.AA[, k, drop=FALSE], NN.M[, 1], DF.PRIOR)[, drop=FALSE]

+##		shrink.tau2B.BB[, k] <- shrink(tau2B.BB[, k, drop=FALSE], NN.M[, 3], DF.PRIOR)[, drop=FALSE]