@@ -71,13 +71,20 @@ export(crlmm,

        snprma,

        snprma2,

        crlmm2,

-       genotype2,

-       batch,

-       crlmmCopynumber2,

-       constructCNSetForIllumina,

-       validCdfNames)

-##export(initializeParamObject, biasAdjNP2)

-##export(construct)

-

-export(plotCNSetLM)

+       genotype2, genotypeLD,

+       crlmmCopynumber2, crlmmCopynumberLD, crlmmCopynumber)

+export(constructIlluminaCNSet)

+export(totalCopynumber)

+export(cnrma, cnrma2)

+exportMethods(A, B, nuA, nuB, phiA, phiB, corr, tau2, Ns, medians, mads)

+export(genotypeSummary,

+       shrinkSummary,

+       estimateCnParameters,

+       shrinkGenotypeSummaries, indexComplete)

+## export(fit.lm1, fit.lm2, fit.lm3, fit.lm4)

+

+## For debugging

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

+

+

@@ -522,7 +522,7 @@ fit.lm2 <- function(strata,

 		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, phiB.snp))

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

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

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

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

@@ -833,7 +833,6 @@ fit.lm4 <- function(strata,

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

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

 	nc <- length(batchNames(object))

-

 	if(enough.males){

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

 					 batches=batches,

@@ -851,7 +850,6 @@ fit.lm4 <- function(strata,

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

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

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

-

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

 	fns <- featureNames(object)[ii]

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

@@ -1382,18 +1380,47 @@ constructIlluminaAssayData <- function(np, snp, object, storage.mode="environmen

 	}

 	np <- lapply(np, stripnames)

 	snp <- lapply(snp, stripnames)

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

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

-	gt <- stripnames(calls(object))

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

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

-	pr <- stripnames(snpCallProbability(object))

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

-	aD <- assayDataNew(storage.mode,

-			   alleleA=A,

-			   alleleB=B,

-			   call=gt,

-			   callProbability=pr)

+	if(is(snp[[1]], "ff")){

+		lapply(snp, open)

+		open(calls(object))

+		open(snpCallProbability(object))

+##		lapply(np, open)

+	}

+	##tmp <- rbind(as.matrix(snp[[1]]), as.matrix(np[[1]]), deparse.level=0)

+	A.snp <- snp[[1]]

+	B.snp <- snp[[2]]

+	##Why is np not a ff object?

+	A.np <- np[[1]]

+	B.np <- np[[2]]

+	nr <- length(order.index)

+	nc <- ncol(object)

+	if(is(A.snp, "ff")){

+		NA.vec <- rep(NA, nrow(A.np))

+		AA <- initializeBigMatrix("A", nr, nc, vmode="integer")

+		BB <- initializeBigMatrix("B", nr, nc, vmode="integer")

+		GG <- initializeBigMatrix("calls", nr, nc, vmode="integer")

+		PP <- initializeBigMatrix("confs", nr, nc, vmode="integer")

+		for(j in 1:ncol(object)){

+			AA[, j] <- c(snp[[1]][, j], np[[1]][, j])[order.index]

+			BB[, j] <- c(snp[[2]][, j], np[[2]][, j])[order.index]

+			GG[, j] <- c(calls(object)[, j], NA.vec)[order.index]

+			PP[, j] <- c(snpCallProbability(object)[, j], NA.vec)[order.index]

+

+		}

+	} else {

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

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

+		gt <- stripnames(calls(object))

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

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

+		pr <- stripnames(snpCallProbability(object))

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

+	}

+	assayDataNew(storage.mode,

+		     alleleA=AA,

+		     alleleB=BB,

+		     call=GG,

+		     callProbability=PP)

 }

 constructIlluminaCNSet <- function(crlmmResult,

 				   path,

@@ -1408,20 +1435,16 @@ constructIlluminaCNSet <- function(crlmmResult,

 	fD <- fD[new.order, ]

 	aD <- constructIlluminaAssayData(cnAB, res, crlmmResult, order.index=new.order)

 	##protocolData(crlmmResult)$batch <- vector("integer", ncol(crlmmResult))

-	batch <- vector("integer", ncol(crlmmResult))

-	container <- new("CNSet",

-			 call=aD[["call"]],

-			 callProbability=aD[["callProbability"]],

-			 alleleA=aD[["alleleA"]],

-			 alleleB=aD[["alleleB"]],

-			 phenoData=phenoData(crlmmResult),

-			 protocolData=protocolData(crlmmResult),

-			 featureData=fD,

-			 batch=batch,

-			 annotation="human370v1c")

-##	lM(container) <- initializeParamObject(list(featureNames(container), unique(protocolData(container)$batch)))

-##	lM(container) <- initializeLmFrom(container)

-	container

+	new("CNSet",

+	    call=aD[["call"]],

+	    callProbability=aD[["callProbability"]],

+	    alleleA=aD[["alleleA"]],

+	    alleleB=aD[["alleleB"]],

+	    phenoData=phenoData(crlmmResult),

+	    protocolData=protocolData(crlmmResult),

+	    featureData=fD,

+	    batch=batch,

+	    annotation="human370v1c")

 }

@@ -1456,8 +1479,8 @@ shrinkSummary <- function(object,

 			  verbose=TRUE,

 			  marker.index,

 			  is.lds){

-	stopifnot(type %in% c("SNP", "X.SNP"))

-	if(type == "X.SNP"){

+	stopifnot(type[[1]] %in% c("SNP", "X.SNP"))

+	if(type[[1]] == "X.SNP"){

 		gender <- object$gender

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

 			return("too few females to estimate within genotype summary statistics on CHR X")

@@ -1474,17 +1497,10 @@ shrinkSummary <- function(object,

 		if(is.lds) stopifnot(isPackageLoaded("ff"))

 		marker.index <- whichMarkers(type[[1]], is.snp, is.autosome, is.annotated, is.X)

 	}

-	summaryFxn <- function(type){

-		switch(type,

-		       SNP="shrinkGenotypeSummaries",

-		       X.SNP="shrinkGenotypeSummaries", ## this shrinks for the females only

-		       stop())

-	}

-	FUN <- summaryFxn(type[[1]])

 	if(is.lds){

 		index.list <- splitIndicesByLength(marker.index, ocProbesets())

 		ocLapply(seq(along=index.list),

-			 FUN,

+			 shrinkGenotypeSummaries,

 			 index.list=index.list,

 			 object=object,

 			 verbose=verbose,

@@ -1494,8 +1510,7 @@ shrinkSummary <- function(object,

 			 is.lds=is.lds,

 			 neededPkgs="crlmm")

 	} else {

-		FUN <- match.fun(FUN)

-		object <- FUN(strata=1,

+		object <- shrinkGenotypeSummaries(strata=1,

 			      index.list=list(marker.index),

 			      object=object,

 			      verbose=verbose,

@@ -1750,7 +1765,7 @@ crlmmCopynumber <- function(object,

 		       X.SNP="chromosome X SNPs",

 		       X.NP="chromosome X nonpolymorphic markers")

 	}

-	if(verbose) message("Computing summary statistics for genotype clusters for each batch")

+	if(verbose) message("Computing summary statistics of the genotype clusters for each batch")

 	for(i in seq_along(type)){

 		## do all types

 		marker.type <- type[i]

@@ -1765,7 +1780,7 @@ crlmmCopynumber <- function(object,

 					  marker.index=marker.index,

 					  is.lds=is.lds)

 	}

-	if(verbose) message("Imputing unobserved cluster medians and shrinking the variances at polymorphic loci")##SNPs only

+	if(verbose) message("Imputing unobserved genotype medians and shrinking the variances (within-batch, across loci) ")##SNPs only

 	for(i in seq_along(type)){

 		marker.type <- type[i]

 		if(!marker.type %in% c("SNP", "X.SNP")) next()

@@ -12,7 +12,187 @@ readIdatFiles <- function(sampleSheet=NULL,

 			  sep="_",

 			  fileExt=list(green="Grn.idat", red="Red.idat"),

 			  saveDate=FALSE) {

+#       if(!is.null(arrayNames)) {

+#	       arrayNames = gsub(paste(sep, fileExt$green, sep=""), "", dir(pattern=fileExt$green, path=path))

+#	       if(!is.null(sampleSheet)) {

+#		       sampleSheet=NULL

+#		       cat("Could not find required info in \'sampleSheet\' - ignoring.  Check \'sampleSheet\' and/or \'arrayInfoColNames\'\n")

+#	       }

+#	       pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))

+#       }

+       if(!is.null(arrayNames)) {

+               pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))

+       }

+       if(!is.null(sampleSheet)) { # get array info from Illumina's sample sheet

+	       if(is.null(arrayNames)){

+		       ##arrayNames=NULL

+		       if(!is.null(arrayInfoColNames$barcode) && (arrayInfoColNames$barcode %in% colnames(sampleSheet))) {

+			       barcode = sampleSheet[,arrayInfoColNames$barcode]

+			       arrayNames=barcode

+		       }

+		       if(!is.null(arrayInfoColNames$position) && (arrayInfoColNames$position %in% colnames(sampleSheet))) {

+			       position = sampleSheet[,arrayInfoColNames$position]

+			       if(is.null(arrayNames))

+				       arrayNames=position

+			       else

+				       arrayNames = paste(arrayNames, position, sep=sep)

+			       if(highDensity) {

+				       hdExt = list(A="R01C01", B="R01C02", C="R02C01", D="R02C02")

+				       for(i in names(hdExt))

+					       arrayNames = sub(paste(sep, i, sep=""), paste(sep, hdExt[[i]], sep=""), arrayNames)

+			       }

+		       }

+	       }

+	       pd = new("AnnotatedDataFrame", data = sampleSheet)

+	       sampleNames(pd) <- basename(arrayNames)

+       }

+       if(is.null(arrayNames)) {

+               arrayNames = gsub(paste(sep, fileExt$green, sep=""), "", dir(pattern=fileExt$green, path=path))

+               if(!is.null(sampleSheet)) {

+                      sampleSheet=NULL

+                      cat("Could not find required info in \'sampleSheet\' - ignoring.  Check \'sampleSheet\' and/or \'arrayInfoColNames\'\n")

+               }

+               pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))

+       }

+       narrays = length(arrayNames)

+       grnfiles = paste(arrayNames, fileExt$green, sep=sep)

+       redfiles = paste(arrayNames, fileExt$red, sep=sep)

+       if(length(grnfiles)==0 || length(redfiles)==0)

+	       stop("Cannot find .idat files")

+       if(length(grnfiles)!=length(redfiles))

+	       stop("Cannot find matching .idat files")

+       if(path[1] != "."){

+	       grnidats = file.path(path, grnfiles)

+	       redidats = file.path(path, redfiles)

+       }  else {

+	       message("path arg not set.  Assuming files are in local directory")

+	       grnidats <- grnfiles

+	       redidats <- redfiles

+       }

+       if(!all(file.exists(grnidats))) stop("Missing some of the *Grn.idat files")

+       if(!all(file.exists(redidats))) stop("Missing some of the *Red.idat files")

+##       if(!all(c(redfiles,grnfiles) %in% dir(path=path))){

+##	       stop("Missing .idat files: red\n", paste(redfiles[!(redfiles %in% dir(path=path))], sep=" "), "\n green\n",

+##		    paste(grnfiles[!(grnfiles %in% dir(path=path))], sep=" "))

+##       }

+       headerInfo = list(nProbes = rep(NA, narrays),

+                         Barcode = rep(NA, narrays),

+                         ChipType = rep(NA, narrays),

+                         Manifest = rep(NA, narrays), # not sure about this one - sometimes blank

+                         Position = rep(NA, narrays)) # this may also vary a bit

+       dates = list(decode=rep(NA, narrays),

+                    scan=rep(NA, narrays))

+       ## read in the data

+       for(i in seq(along=arrayNames)) {

+	       cat("reading", arrayNames[i], "\t")

+	       idsG = idsR = G = R = NULL

+	       cat(paste(sep, fileExt$green, sep=""), "\t")

+	       G = readIDAT(grnidats[i])

+	       idsG = rownames(G$Quants)

+	       headerInfo$nProbes[i] = G$nSNPsRead

+	       headerInfo$Barcode[i] = G$Barcode

+	       headerInfo$ChipType[i] = G$ChipType

+	       headerInfo$Manifest[i] = G$Unknown$MostlyNull

+	       headerInfo$Position[i] = G$Unknowns$MostlyA

+               if(headerInfo$nProbes[i]>(headerInfo$nProbes[1]+10000) || headerInfo$nProbes[i]<(headerInfo$nProbes[1]-10000)) {

+                       ## headerInfo$ChipType[i]!=headerInfo$ChipType[1] || headerInfo$Manifest[i]!=headerInfo$Manifest[1]) {

+		       ## || headerInfo$nProbes[i]!=headerInfo$nProbes[1] ## removed this condition as some arrays used the same manifest

+		       ## but differed by a few SNPs for some reason - most of the chip was the same though

+		       ##           stop("Chips are not of all of the same type - please check your data")

+		       warning("Chips are not of the same type.  Skipping ", basename(grnidats[i]), " and ", basename(redidats[i]))

+		       next()

+	       }

+	       dates$decode[i] = G$RunInfo[1, 1]

+	       dates$scan[i] = G$RunInfo[2, 1]

+	       if(i==1) {

+		       if(is.null(ids) && !is.null(G)){

+			       ids = idsG

+		       }else stop("Could not find probe IDs")

+		       nprobes = length(ids)

+		       narrays = length(arrayNames)

+		       tmpmat = matrix(NA, nprobes, narrays)

+		       rownames(tmpmat) = ids

+		       if(!is.null(sampleSheet)){

+			       colnames(tmpmat) = sampleSheet$Sample_ID

+		       }else  colnames(tmpmat) = arrayNames

+		       RG <- new("NChannelSet",

+				 R=tmpmat,

+				 G=tmpmat,

+				 zero=tmpmat,

+#				 Rnb=tmpmat,

+#				 Gnb=tmpmat,

+#				 Rse=tmpmat,

+#				 Gse=tmpmat,

+				 annotation=headerInfo$Manifest[1],

+				 phenoData=pd,

+				 storage.mode="environment")

+		       rm(tmpmat)

+		       gc()

+	       }

+	       if(length(ids)==length(idsG)) {

+		       if(sum(ids==idsG)==nprobes) {

+			       RG@assayData$G[,i] = G$Quants[, "Mean"]

+				   zeroG = G$Quants[, "NBeads"]==0

+#			       RG@assayData$Gnb[,i] = G$Quants[, "NBeads"]

+#			       RG@assayData$Gse[,i] = G$Quants[, "SD"]

+		       }

+	       } else {

+		       indG = match(ids, idsG)

+		       RG@assayData$G[,i] = G$Quants[indG, "Mean"]

+			   zeroG = G$Quants[indG, "NBeads"]==0

+#		       RG@assayData$Gnb[,i] = G$Quants[indG, "NBeads"]

+#		       RG@assayData$Gse[,i] = G$Quants[indG, "SD"]

+	       }

+	       rm(G)

+	       gc()

+

+	       cat(paste(sep, fileExt$red, sep=""), "\n")

+	       R = readIDAT(redidats[i])

+	       idsR = rownames(R$Quants)

+	       if(length(ids)==length(idsG)) {

+		       if(sum(ids==idsR)==nprobes) {

+			       RG@assayData$R[,i] = R$Quants[ ,"Mean"]

+				   zeroR = R$Quants[ ,"NBeads"]==0

+#			       RG@assayData$Rnb[,i] = R$Quants[ ,"NBeads"]

+#			       RG@assayData$Rse[,i] = R$Quants[ ,"SD"]

+		       }

+	       } else {

+		       indR = match(ids, idsR)

+		       RG@assayData$R[,i] = R$Quants[indR, "Mean"]

+			   zeroR = R$Quants[indR, "NBeads"]==0

+#		       RG@assayData$Rnb[,i] = R$Quants[indR, "NBeads"]

+#		       RG@assayData$Rse[,i] = R$Quants[indR, "SD"]

+	       }

+		   RG@assayData$zero[,i] = zeroG | zeroR

+	       rm(R, zeroG, zeroR)

+	       gc()

+       }

+       if(saveDate) {

+	       protocolData(RG)[["ScanDate"]] = dates$scan

+       }

+       storageMode(RG) = "lockedEnvironment"

+       RG

+}

+

+

+readIdatFiles2 <- function(sampleSheet=NULL,

+			  arrayNames=NULL,

+			  ids=NULL,

+			  path=".",

+			  arrayInfoColNames=list(barcode="SentrixBarcode_A", position="SentrixPosition_A"),

+			  highDensity=FALSE,

+			  sep="_",

+			  fileExt=list(green="Grn.idat", red="Red.idat"),

+			  saveDate=FALSE) {

+#       if(!is.null(arrayNames)) {

+#	       arrayNames = gsub(paste(sep, fileExt$green, sep=""), "", dir(pattern=fileExt$green, path=path))

+#	       if(!is.null(sampleSheet)) {

+#		       sampleSheet=NULL

+#		       cat("Could not find required info in \'sampleSheet\' - ignoring.  Check \'sampleSheet\' and/or \'arrayInfoColNames\'\n")

+#	       }

+#	       pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))

+#       }

        if(!is.null(arrayNames)) {

                pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))

        }

@@ -64,6 +244,10 @@ readIdatFiles <- function(sampleSheet=NULL,

        }

        if(!all(file.exists(grnidats))) stop("Missing some of the *Grn.idat files")

        if(!all(file.exists(redidats))) stop("Missing some of the *Red.idat files")

+##       if(!all(c(redfiles,grnfiles) %in% dir(path=path))){

+##	       stop("Missing .idat files: red\n", paste(redfiles[!(redfiles %in% dir(path=path))], sep=" "), "\n green\n",

+##		    paste(grnfiles[!(grnfiles %in% dir(path=path))], sep=" "))

+##       }

        headerInfo = list(nProbes = rep(NA, narrays),

                          Barcode = rep(NA, narrays),

                          ChipType = rep(NA, narrays),

@@ -410,6 +594,113 @@ readBPM <- function(bpmFile){

 }

+RGtoXY = function(RG, chipType, verbose=TRUE) {

+  chipList = c("human1mv1c",             # 1M

+               "human370v1c",            # 370CNV

+               "human650v3a",            # 650Y

+               "human610quadv1b",        # 610 quad

+               "human660quadv1a",        # 660 quad

+               "human370quadv3c",        # 370CNV quad

+               "human550v3b",            # 550K

+               "human1mduov3b",          # 1M Duo

+               "humanomni1quadv1b",      # Omni1 quad

+               "humanomniexpress12v1b") # Omni express 12

+  if(missing(chipType)){

+	  chipType = match.arg(annotation(RG), chipList)

+  } else chipType = match.arg(chipType, chipList)

+

+  pkgname <- getCrlmmAnnotationName(chipType)

+  if(!require(pkgname, character.only=TRUE, quietly=!verbose)){

+     suggCall <- paste("library(", pkgname, ", lib.loc='/Altern/Lib/Loc')", sep="")

+     msg <- paste("If", pkgname, "is installed on an alternative location, please load it manually by using", suggCall)

+     message(strwrap(msg))

+     stop("Package ", pkgname, " could not be found.")

+     rm(suggCall, msg)

+  }

+  if(verbose) message("Loading chip annotation information.")

+    loader("address.rda", .crlmmPkgEnv, pkgname)

+#    data(annotation, package=pkgname, envir=.crlmmPkgEnv)

+  aids <- getVarInEnv("addressA") # comes from AddressA_ID or Address column in manifest

+  bids <- getVarInEnv("addressB") # comes from AddressB_ID or Address2 column in manifest

+  ids <- names(aids)

+  snpbase <- getVarInEnv("base")

+

+  nsnps = length(aids)

+  narrays = ncol(RG)

+

+#  aidcol = match("AddressA_ID", colnames(annot))

+#  if(is.na(aidcol))

+#    aidcol = match("Address", colnames(annot))

+#  bidcol = match("AddressB_ID", colnames(annot))

+#  if(is.na(bidcol))

+#    bidcol = match("Address2", colnames(annot))

+#  aids = annot[, aidcol]

+#  bids = annot[, bidcol]

+#  snpids = annot[,"Name"]

+#  snpbase = annot[,"SNP"]

+  infI = !is.na(bids) & bids!=0

+  aord = match(aids, featureNames(RG)) # NAs are possible here

+  bord = match(bids, featureNames(RG)) # and here

+#  argrg = aids[rrgg]

+#  brgrg = bids[rrgg]

+

+  tmpmat = matrix(as.integer(0), nsnps, narrays)

+  rownames(tmpmat) = ids

+  colnames(tmpmat) = sampleNames(RG)

+  XY = new("NChannelSet", X=tmpmat, Y=tmpmat, zero=tmpmat, # Xnb=tmpmat, Ynb=tmpmat, Xse=tmpmat, Yse=tmpmat, zero=tmpmat,

+                 annotation=chipType, phenoData=RG@phenoData, protocolData=RG@protocolData, storage.mode="environment")

+  rm(tmpmat)

+  gc()

+

+  # First sort out Infinium II SNPs, X -> R (allele A)  and Y -> G (allele B) from the same probe

+  XY@assayData$X[!is.na(aord),] = exprs(channel(RG, "R"))[aord[!is.na(aord)],] # mostly red

+  XY@assayData$Y[!is.na(aord),] = exprs(channel(RG, "G"))[aord[!is.na(aord)],] # mostly green

+  XY@assayData$zero[!is.na(aord),] = exprs(channel(RG, "zero"))[aord[!is.na(aord)],] # mostly green

+#  XY@assayData$Xnb[!is.na(aord),] = exprs(channel(RG, "Rnb"))[aord[!is.na(aord)],]

+#  XY@assayData$Ynb[!is.na(aord),] = exprs(channel(RG, "Gnb"))[aord[!is.na(aord)],]

+#  XY@assayData$Xse[!is.na(aord),] = exprs(channel(RG, "Rse"))[aord[!is.na(aord)],]

+#  XY@assayData$Yse[!is.na(aord),] = exprs(channel(RG, "Gse"))[aord[!is.na(aord)],]

+  gc()

+

+  ## Warning - not 100% sure that the code below is correct - could be more complicated than this

+

+  # Next Infinium I where X -> R from allele A probe and Y -> R from allele B probe

+#  infIRR = infI & (snpbase=="[A/T]" | snpbase=="[T/A]" | snpbase=="[a/t]" | snpbase=="[t/a]")

+

+#  X[infIRR,] = exprs(channel(RG, "R"))[aord[infIRR],] # mostly red

+#  Y[infIRR,] = exprs(channel(RG, "R"))[bord[infIRR],] # mostly green

+#  Xnb[infIRR,] = exprs(channel(RG, "Rnb"))[aord[infIRR],]

+#  Ynb[infIRR,] = exprs(channel(RG, "Rnb"))[bord[infIRR],]

+#  Xse[infIRR,] = exprs(channel(RG, "Rse"))[aord[infIRR],]

+#  Yse[infIRR,] = exprs(channel(RG, "Rse"))[bord[infIRR],]

+

+  # Finally Infinium I where X -> G from allele A probe and Y -> G from allele B probe

+#  infIGG = infI & (snpbase=="[C/G]" | snpbase=="[G/C]" | snpbase=="[g/c]" | snpbase=="[c/g]")

+

+#  X[infIGG,] = exprs(channel(RG, "G"))[aord[infIGG],] # mostly red

+#  Y[infIGG,] = exprs(channel(RG, "G"))[bord[infIGG],] # mostly green

+#  Xnb[infIGG,] = exprs(channel(RG, "Gnb"))[aord[infIGG],]

+#  Ynb[infIGG,] = exprs(channel(RG, "Gnb"))[bord[infIGG],]

+#  Xse[infIGG,] = exprs(channel(RG, "Gse"))[aord[infIGG],]

+#  Yse[infIGG,] = exprs(channel(RG, "Gse"))[bord[infIGG],]

+

+  #  For now zero out Infinium I probes

+  XY@assayData$X[infI,] = 0

+  XY@assayData$Y[infI,] = 0

+  XY@assayData$zero[infI,] = 0

+#  XY@assayData$Xnb[infI,] = 0

+#  XY@assayData$Ynb[infI,] = 0

+#  XY@assayData$Xse[infI,] = 0

+#  XY@assayData$Yse[infI,] = 0

+

+#  XY@assayData$zero[XY@assayData$X==0 | XY@assayData$Y==0] = 1

+  gc()

+

+#  storageMode(XY) = "lockedEnvironment"

+  XY

+}

+

+

 RGtoXY = function(RG, chipType, verbose=TRUE) {

   chipList = c("human1mv1c",             # 1M

                "human370v1c",            # 370CNV

@@ -472,9 +763,6 @@ RGtoXY = function(RG, chipType, verbose=TRUE) {

   XY@assayData$Y[1:nsnps,] = 0

   XY@assayData$zero[1:nsnps,] = 0

-  open(RG@assayData$R)

-  open(RG@assayData$G)

-  open(RG@assayData$zero)

   # First sort out Infinium II SNPs, X -> R (allele A)  and Y -> G (allele B) from the same probe

   XY@assayData$X[!is.na(aord),] = exprs(channel(RG, "R"))[aord[!is.na(aord)],] # mostly red

@@ -482,10 +770,6 @@ RGtoXY = function(RG, chipType, verbose=TRUE) {

   XY@assayData$zero[!is.na(aord),] = exprs(channel(RG, "zero"))[aord[!is.na(aord)],] # mostly green

   gc()

-  close(RG@assayData$R)

-  close(RG@assayData$G)

-  close(RG@assayData$zero)

-

   ## Warning - not 100% sure that the code below is correct - could be more complicated than this

   # Next Infinium I where X -> R from allele A probe and Y -> R from allele B probe

@@ -493,17 +777,31 @@ RGtoXY = function(RG, chipType, verbose=TRUE) {

 #  X[infIRR,] = exprs(channel(RG, "R"))[aord[infIRR],] # mostly red

 #  Y[infIRR,] = exprs(channel(RG, "R"))[bord[infIRR],] # mostly green

+#  Xnb[infIRR,] = exprs(channel(RG, "Rnb"))[aord[infIRR],]

+#  Ynb[infIRR,] = exprs(channel(RG, "Rnb"))[bord[infIRR],]

+#  Xse[infIRR,] = exprs(channel(RG, "Rse"))[aord[infIRR],]

+#  Yse[infIRR,] = exprs(channel(RG, "Rse"))[bord[infIRR],]

   # Finally Infinium I where X -> G from allele A probe and Y -> G from allele B probe

 #  infIGG = infI & (snpbase=="[C/G]" | snpbase=="[G/C]" | snpbase=="[g/c]" | snpbase=="[c/g]")

 #  X[infIGG,] = exprs(channel(RG, "G"))[aord[infIGG],] # mostly red

 #  Y[infIGG,] = exprs(channel(RG, "G"))[bord[infIGG],] # mostly green

+#  Xnb[infIGG,] = exprs(channel(RG, "Gnb"))[aord[infIGG],]

+#  Ynb[infIGG,] = exprs(channel(RG, "Gnb"))[bord[infIGG],]

+#  Xse[infIGG,] = exprs(channel(RG, "Gse"))[aord[infIGG],]

+#  Yse[infIGG,] = exprs(channel(RG, "Gse"))[bord[infIGG],]

   #  For now zero out Infinium I probes

   XY@assayData$X[infI,] = 0

   XY@assayData$Y[infI,] = 0

   XY@assayData$zero[infI,] = 0

+#  XY@assayData$Xnb[infI,] = 0

+#  XY@assayData$Ynb[infI,] = 0

+#  XY@assayData$Xse[infI,] = 0

+#  XY@assayData$Yse[infI,] = 0

+

+#  XY@assayData$zero[XY@assayData$X==0 | XY@assayData$Y==0] = 1

   gc()

 #  if(class(XY@assayData$X)[1]=="ff_matrix") {

@@ -534,11 +832,14 @@ stripNormalize = function(XY, useTarget=TRUE, verbose=TRUE) {

   if(useTarget)

     targetdist = getVarInEnv("reference")

+#  Xqws = Yqws = matrix(0, nrow(XY), ncol(XY))

+#  colnames(Xqws) = colnames(Yqws) = sampleNames(XY) #$X

+#  rownames(Xqws) = rownames(Yqws) = featureNames(XY)

+

   if(verbose){

     message("Quantile normalizing ", ncol(XY), " arrays by ", max(stripnum), " strips.")

     if (getRversion() > '2.7.0') pb <- txtProgressBar(min=0, max=max(stripnum), style=3)

   }

-

 #  if(class(XY@assayData$X)[1]=="ff_matrix") {

     open(XY@assayData$X)

     open(XY@assayData$Y)

@@ -574,6 +875,146 @@ stripNormalize = function(XY, useTarget=TRUE, verbose=TRUE) {

 preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,

+				fitMixture=TRUE,

+				eps=0.1,

+				verbose=TRUE,

+				seed=1,

+				cdfName,

+				sns,

+				stripNorm=TRUE,

+				useTarget=TRUE,

+				save.it=FALSE,

+				snpFile,

+				cnFile) {

+  if(stripNorm)

+    XY = stripNormalize(XY, useTarget=useTarget, verbose=verbose)

+

+## MR: the code below is mostly straight from snprma.R

+  if (missing(sns)) sns <- sampleNames(XY) #$X

+  if(missing(cdfName))

+    cdfName <- annotation(XY)

+##  stuffDir <- changeToCrlmmAnnotationName(cdfName)

+  pkgname <- getCrlmmAnnotationName(cdfName)

+  if(!require(pkgname, character.only=TRUE, quietly=!verbose)){

+    suggCall <- paste("library(", pkgname, ", lib.loc='/Altern/Lib/Loc')", sep="")

+    msg <- paste("If", pkgname, "is installed on an alternative location, please load it manually by using", suggCall)

+    message(strwrap(msg))

+    stop("Package ", pkgname, " could not be found.")

+    rm(suggCall, msg)

+  }

+  if(verbose) message("Loading snp annotation and mixture model parameters.")

+  loader("genotypeStuff.rda", .crlmmPkgEnv, pkgname)

+  loader("mixtureStuff.rda", .crlmmPkgEnv, pkgname)

+  loader("snpProbesFid.rda", .crlmmPkgEnv, pkgname)

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

+#  data(genotypeStuff, mixtureStuff, package=pkgname, envir=.crlmmPkgEnv)

+  autosomeIndex <- getVarInEnv("autosomeIndex")

+  #  pnsa <- getVarInEnv("pnsa")

+  #  pnsb <- getVarInEnv("pnsb")

+  #  fid <- getVarInEnv("fid")

+  #  reference <- getVarInEnv("reference")

+  #  aIndex <- getVarInEnv("aIndex")

+  #  bIndex <- getVarInEnv("bIndex")

+  SMEDIAN <- getVarInEnv("SMEDIAN")

+  theKnots <- getVarInEnv("theKnots")

+  gns <- getVarInEnv("gns")

+

+  # separate out copy number probes

+  npIndex = getVarInEnv("npProbesFid")

+  nprobes = length(npIndex)

+  if(length(nprobes)>0) {

+    narrays = ncol(XY)

+    A <- matrix(as.integer(exprs(channel(XY, "X"))[npIndex,]), nprobes, narrays)

+    B <- matrix(as.integer(exprs(channel(XY, "Y"))[npIndex,]), nprobes, narrays)

+

+    # new lines below - useful to keep track of zeroed out probes

+    zero <- matrix(as.integer(exprs(channel(XY, "zero"))[npIndex,]), nprobes, narrays)

+

+    colnames(A) <- colnames(B) <- colnames(zero) <- sns

+    rownames(A) <- rownames(B) <- rownames(zero) <- names(npIndex)

+

+    cnAB = list(A=A, B=B, zero=zero, sns=sns, gns=names(npIndex), cdfName=cdfName)

+    if(save.it & !missing(cnFile)) {

+      t0 <- proc.time()

+      save(cnAB, file=cnFile)

+      t0 <- proc.time()-t0

+      if(verbose) message("Used ", round(t0[3],1), " seconds to save ", cnFile, ".")

+    }

+    rm(cnAB, B, zero)

+  }

+

+  # next process snp probes

+  snpIndex = getVarInEnv("snpProbesFid")

+  nprobes <- length(snpIndex)

+

+  ##We will read each cel file, summarize, and run EM one by one

+  ##We will save parameters of EM to use later

+  mixtureParams <- matrix(0, 4, narrays)

+  SNR <- vector("numeric", narrays)

+  SKW <- vector("numeric", narrays)

+

+  ## This is the sample for the fitting of splines

+  ## BC: I like better the idea of the user passing the seed,

+  ##     because this might intefere with other analyses

+  ##     (like what happened to GCRMA)

+  set.seed(seed)

+  idx <- sort(sample(autosomeIndex, mixtureSampleSize))

+  idx2 <- sample(nprobes, 10^5)

+

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

+  A <- matrix(as.integer(exprs(channel(XY, "X"))[snpIndex,]), nprobes, narrays) # matrix(as.integer(0), length(pnsa), length(filenames))

+  B <- matrix(as.integer(exprs(channel(XY, "Y"))[snpIndex,]), nprobes, narrays) # matrix(as.integer(0), length(pnsb), length(filenames))

+

+  # new lines below - useful to keep track of zeroed out SNPs

+  zero <- matrix(as.integer(exprs(channel(XY, "zero"))[snpIndex,]), nprobes, narrays)

+

+  colnames(A) <- colnames(B) <- colnames(zero) <- sns

+  rownames(A) <- rownames(B) <- rownames(zero) <- names(snpIndex) # gns # featureNames(XY)

+

+  if(verbose){

+     message("Calibrating ", narrays, " arrays.")

+     if (getRversion() > '2.7.0') pb <- txtProgressBar(min=0, max=narrays, style=3)

+  }

+

+

+  for(i in 1:narrays){

+    SKW[i] = mean((A[idx2,i]-mean(A[idx2,i]))^3)/(sd(A[idx2,i])^3)

+    if(fitMixture){

+      S <- (log2(A[idx, i])+log2(B[idx, i]))/2 - SMEDIAN

+      M <- log2(A[idx, i])-log2(B[idx, i])

+

+      ##we need to test the choice of eps.. it is not the max diff between funcs

+      tmp <- fitAffySnpMixture56(S, M, theKnots, eps=eps)

+

+      mixtureParams[, i] <- tmp[["coef"]]

+      SNR[i] <- tmp[["medF1"]]^2/(tmp[["sigma1"]]^2+tmp[["sigma2"]]^2)

+    }

+    if(verbose) {

+       if (getRversion() > '2.7.0') setTxtProgressBar(pb, i)

+       else cat(".")

+    }

+  }

+  if (verbose) {

+    if (getRversion() > '2.7.0') close(pb)

+    else cat("\n")

+  }

+  if (!fitMixture) SNR <- mixtureParams <- NA

+  ## gns comes from preprocStuff.rda

+  res = list(A=A, B=B, zero=zero, sns=sns, gns=gns, SNR=SNR, SKW=SKW, mixtureParams=mixtureParams, cdfName=cdfName)

+

+  if(save.it & !missing(snpFile)) {

+    t0 <- proc.time()

+    save(res, file=snpFile)

+    t0 <- proc.time()-t0

+    if(verbose) message("Used ", round(t0[3],1), " seconds to save ", snpFile, ".")

+  }

+  return(res)

+}

+

+

+preprocessInfinium2v2 <- function(XY, mixtureSampleSize=10^5,

 				fitMixture=TRUE,

 				eps=0.1,

 				verbose=TRUE,

@@ -625,10 +1066,6 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,

       # new lines below - useful to keep track of zeroed out probes

       zero <- matrix(as.integer(exprs(channel(XY, "zero"))[npIndex,]), nprobes, narrays)

-      close(XY@assayData$X)

-      close(XY@assayData$Y)

-      close(XY@assayData$zero)

-

       colnames(A) <- colnames(B) <- colnames(zero) <- sns

       rownames(A) <- rownames(B) <- rownames(zero) <- names(npIndex)

@@ -651,6 +1088,9 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,

   mixtureParams <- initializeBigMatrix("crlmmMixt-", 4, narrays, "double")

   SNR <- initializeBigVector("crlmmSNR-", narrays, "double")

   SKW <- initializeBigVector("crlmmSKW-", narrays, "double")

+#  mixtureParams <- matrix(0, 4, narrays)

+#  SNR <- vector("numeric", narrays)

+#  SKW <- vector("numeric", narrays)

   ## This is the sample for the fitting of splines

   ## BC: I like better the idea of the user passing the seed,

@@ -663,6 +1103,25 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,

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

+#  A <- exprs(channel(XY, "X"))[,] # ), nrow(XY), narrays) # [snpIndex,]), nprobes, narrays) # matrix(as.integer(0), length(pnsa), length(filenames))

+#  B <- exprs(channel(XY, "Y"))[,] # ), nrow(XY), narrays) # [snpIndex,]), nprobes, narrays) # matrix(as.integer(0), length(pnsb), length(filenames))

+

+  # new lines below - useful to keep track of zeroed out SNPs

+#  zero <- exprs(channel(XY, "zero"))[,] # )) #[snpIndex,]), nprobes, narrays)

+

+#  if(!is.matrix(A)) {

+#     A = A[,]

+#     B = B[,]

+#     zero = zero[,]

+#  }

+

+#  if(!is.integer(A)) {

+#     A = matrix(as.integer(A), nrow(A), ncol(A))

+#     B = matrix(as.integer(B), nrow(B), ncol(B))

+#  }

+

+#  colnames(A) <- colnames(B) <- colnames(zero) <- sns

+#  rownames(A) <- rownames(B) <- rownames(zero) <- names(snpIndex) # gns # featureNames(XY)

   A <- initializeBigMatrix("crlmmA-", nprobes, narrays, "integer")

   B <- initializeBigMatrix("crlmmB-", nprobes, narrays, "integer")

@@ -705,10 +1164,12 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,

   if (!fitMixture) SNR <- mixtureParams <- NA

   ## gns comes from preprocStuff.rda

-  close(XY@assayData$X)

-  close(XY@assayData$Y)

-  close(XY@assayData$zero)

-

+  if(save.it & !missing(snpFile)) {

+    t0 <- proc.time()

+    save(res, file=snpFile)

+    t0 <- proc.time()-t0

+    if(verbose) message("Used ", round(t0[3],1), " seconds to save ", snpFile, ".")

+  }

 #  if(class(A)[1]=="ff_matrix") {

     close(A)

     close(B)

@@ -774,6 +1235,61 @@ crlmmIllumina <- function(RG, XY, stripNorm=TRUE, useTarget=TRUE,

     res = preprocessInfinium2(XY, mixtureSampleSize=mixtureSampleSize, fitMixture=TRUE, verbose=verbose,

                         seed=seed, eps=eps, cdfName=cdfName, sns=sns, stripNorm=stripNorm, useTarget=useTarget,

                         save.it=save.it, snpFile=snpFile, cnFile=cnFile)

+  }else{

+      if(verbose) message("Loading ", snpFile, ".")

+        obj <- load(snpFile)

+        if(verbose) message("Done.")

+        if(!any(obj == "res"))

+          stop("Object in ", snpFile, " seems to be invalid.")

+  }

+  if(row.names) row.names=res[["gns"]] else row.names=NULL

+  if(col.names) col.names=res[["sns"]] else col.names=NULL

+

+  res2 <- crlmmGT(res[["A"]], res[["B"]], res[["SNR"]],

+                  res[["mixtureParams"]], res[["cdfName"]],

+                  gender=gender, row.names=row.names,

+                  col.names=col.names, recallMin=recallMin,

+                  recallRegMin=1000, SNRMin=SNRMin,

+                  returnParams=returnParams, badSNP=badSNP,

+                  verbose=verbose)

+

+  res2[["SNR"]] <- res[["SNR"]]

+  res2[["SKW"]] <- res[["SKW"]]

+  rm(res)

+  gc()

+  return(list2SnpSet(res2, returnParams=returnParams)) # return(res2)

+}

+

+

+crlmmIllumina2 <- function(RG, XY, stripNorm=TRUE, useTarget=TRUE,

+                  row.names=TRUE, col.names=TRUE,

+                  probs=c(1/3, 1/3, 1/3), DF=6, SNRMin=5, gender=NULL,

+                  seed=1, save.it=FALSE, load.it=FALSE, snpFile, cnFile,

+                  mixtureSampleSize=10^5, eps=0.1, verbose=TRUE,

+                  cdfName, sns, recallMin=10, recallRegMin=1000,

+                  returnParams=FALSE, badSNP=.7) {

+  if (save.it & (missing(snpFile) | missing(cnFile)))

+    stop("'snpFile' and/or 'cnFile' is missing and you chose to save.it")

+  if (load.it & missing(snpFile))

+    stop("'snpFile' is missing and you chose to load.it")

+  if (!missing(snpFile))

+    if (load.it & !file.exists(snpFile)){

+      load.it <- FALSE

+      message("File ", snpFile, " does not exist.")

+      stop("Cannot load SNP data.")

+  }

+  if (!load.it){

+    if(!missing(RG)) {

+      if(missing(XY))

+        XY = RGtoXY2(RG, chipType=cdfName)

+      else

+        stop("Both RG and XY specified - please use one or the other")

+    }

+    if (missing(sns)) sns <- sampleNames(XY) #$X

+

+    res = preprocessInfinium2v2(XY, mixtureSampleSize=mixtureSampleSize, fitMixture=TRUE, verbose=verbose,

+                        seed=seed, eps=eps, cdfName=cdfName, sns=sns, stripNorm=stripNorm, useTarget=useTarget) #,

+                      #  save.it=save.it, snpFile=snpFile, cnFile=cnFile)

 #    fD = featureData(XY)

 #    phenD = XY@phenoData

@@ -801,12 +1317,7 @@ crlmmIllumina <- function(RG, XY, stripNorm=TRUE, useTarget=TRUE,

           stop("Object in ", snpFile, " seems to be invalid.")

   }

-    open(res[["A"]])

-    open(res[["B"]])

-    open(res[["SNR"]])

-    open(res[["mixtureParams"]])

-

-#    rm(phenD, protD , fD)

+ #   rm(phenD, protD , fD)

 #    snp.index <- res$snpIndex #match(res$gns, featureNames(callSet))

 #    suppressWarnings(A(callSet) <- res[["A"]])

@@ -867,7 +1378,7 @@ crlmmIlluminaV2 = function(sampleSheet=NULL,

 #                          rgFile,

 			  stripNorm=TRUE,

 			  useTarget=TRUE,

-			  row.names=TRUE,

+          	          row.names=TRUE,

 			  col.names=TRUE,

 			  probs=c(1/3, 1/3, 1/3), DF=6, SNRMin=5, gender=NULL,

                           seed=1, save.it=FALSE, snpFile, cnFile,

@@ -1,11 +1,15 @@

 setMethod("Ns", signature(object="AssayData"),

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

-		  if(!missing(j)){

-			  batchnames <- unique(as.character(batch(object)[j]))

-		  } else batchnames <- batchNames(object)