@@ -124,7 +124,6 @@ genotype <- function(filenames,

 		       snprma=snprma(...),

 		       snprma2=snprma2(...))

 	}

-

 	snprmaRes <- snprmaFxn(FUN,

 			       filenames=filenames,

 			       mixtureSampleSize=mixtureSampleSize,

@@ -151,12 +150,18 @@ genotype <- function(filenames,

 		open(snprmaRes[["B"]])

 		open(snprmaRes[["SNR"]])

 		open(snprmaRes[["mixtureParams"]])

-		##bb <- getOption("ffbatchbytes")

-		message("Writing normalized intensities to callSet")

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

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

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

-		}

+		bb <- getOption("ffbatchbytes")

+		ffcolapply(A(callSet)[is.snp, i1:i2] <- snprmaRes[["A"]][snp.index, i1:i2], X=snprmaRes[["A"]],

+			   BATCHBYTES=bb)

+		ffcolapply(B(callSet)[is.snp, i1:i2] <- snprmaRes[["B"]][snp.index, i1:i2], X=snprmaRes[["B"]],

+			   BATCHBYTES=bb)

+##		##bb <- getOption("ffbatchbytes")

+##		message("Writing normalized intensities to callSet")

+##		system.time(

+##		for(j in 1:ncol(callSet)){

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

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

+##		})

 		##ffrowapply(A(callSet)[i1:i2, ] <- snprmaRes[["A"]][i1:i2, ], X=snprmaRes[["A"]])##, BATCHBYTES=bb)

 		##ffrowapply(B(callSet)[i1:i2, ] <- snprmaRes[["B"]][i1:i2, ], X=snprmaRes[["B"]])##, BATCHBYTES=bb)

 		pData(callSet)$SKW <- snprmaRes[["SKW"]]

@@ -213,15 +218,19 @@ genotype <- function(filenames,

 	if(is.lds){

 		open(tmp[["calls"]])

 		open(tmp[["confs"]])

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

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

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

-		}

+		ffcolapply(snpCall(callSet)[is.snp, i1:i2] <- tmp[["A"]][snp.index, i1:i2], X=tmp[["A"]],

+			   BATCHBYTES=bb)

+		ffcolapply(snpCallProbability(callSet)[is.snp, i1:i2] <- tmp[["B"]][snp.index, i1:i2], X=tmp[["B"]],

+			   BATCHBYTES=bb)

+##		for(j in 1:ncol(callSet)){

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

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

+##		}

 		##		ffrowapply(snpCall(callSet)[i1:i2, ] <- tmp[["calls"]][i1:i2, ], X=tmp[["calls"]])#, BATCHBYTES=bb)

 		##		ffrowapply(snpCallProbability(callSet)[i1:i2, ] <- tmp[["confs"]][i1:i2, ], X=tmp[["confs"]])#, BATCHBYTES=bb)

 	} else {

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

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

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

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

 	}

 	message("Finished updating.  Cleaning up.")

 	callSet$gender <- tmp$gender

@@ -358,28 +358,26 @@ C3 <- function(object, allele, marker.index, batch.index, sample.index){

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

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

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

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

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

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

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

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

 		IA <- A(object)[marker.index, jj]

 		IB <- B(object)[marker.index, jj]

-		##phistar <- phiB2/phiA

-		##tmp <- (IB - nuB - phistar*IA + phistar*nuA)/phiB

-		CB <- 1/(1-phiA2*phiB2/(phiA*phiB)) * 1/phiB * (IA-nuB-phiB2/phiA*(IA-nuA))

-		##CB <- tmp/(1-phistar*phiA2/phiB)

+		phistar <- phiB2/phiA

+		tmp <- (IB - nuB - phistar*IA + phistar*nuA)/phiB

+		CB <- tmp/(1-phistar*phiA2/phiB)

+		##CB <- 1/(1-phiA2*phiB2/(phiA*phiB)) * 1/phiB * (IA-nuB-phiB2/phiA*(IA-nuA))

+		CA <- (IA-nuA-phiA2*CB)/phiA

 		if(allele == "B"){

 			acn[[k]] <- CB

 		}

 		if(allele == "A"){

-			ca <- (IA-nuA-phiA2*CB)/phiA

-			acn[[k]] <- ca

-		}

-		if(allele == "AandB"){

-			CA <- tmp/(1-phistar*phiA2/phiB)

-			CB <- (IA-nuA-phiA2*CB)/phiA

-			acn[[k]] <- CA+CB

+			acn[[k]] <- CA

 		}

+##		if(allele=="AandB")

+##			CA <- tmp/(1-phistar*phiA2/phiB)

+##			CB <- (IA-nuA-phiA2*CB)/phiA

+##			acn[[k]] <- CA+CB

+##		}

 	}

 	if(length(acn) > 1){

 		acn <- do.call("cbind", acn)

@@ -494,20 +492,15 @@ ACN <- function(object, allele, i , j){

 			open(phiB(object))

 			open(B(object))

 		}

-		if(any(!is.snp)){

-			acn.index <- which(!is.snp)

-			marker.index <- i[!is.snp]

-			acn[acn.index, ] <- 0

+		if(any(is.auto)){

+			auto.index <- which(is.auto)

+			marker.index <- i[is.auto]

+			acn[auto.index, ] <- C2(object, marker.index, batch.index, j)

 		}

-		if(any(is.snp)){

-			if(any(is.auto)){

-				## autosomal SNPs

-				acn.index <- which(is.auto & is.snp)

-				marker.index <- i[is.auto & is.snp]

-				acn[acn.index, ] <- C2(object, marker.index, batch.index, j)

-			}

-			if(any(is.X)){

-				if(is.ff){

+		if(any(is.X)){

+			##Chr X SNPs

+			if(any(is.snp)){

+				if(is.ff) {

 					open(phiPrimeA(object))

 					open(phiPrimeB(object))

 					open(phiA(object))

@@ -517,7 +510,7 @@ ACN <- function(object, allele, i , j){

 				marker.index <- i[is.X & is.snp]

 				acn.index <- which(is.X & is.snp)

 				acn[acn.index, ] <- C3(object, allele="B", marker.index, batch.index, j)

-				if(is.ff){

+				if(is.ff) {

 					close(phiPrimeA(object))

 					close(phiPrimeB(object))

 					close(phiA(object))

@@ -525,6 +518,11 @@ ACN <- function(object, allele, i , j){

 					close(A(object))

 				}

 			}

+			if(any(!is.snp)){

+				acn.index <- which(!is.snp)

+				marker.index <- i[!is.snp]

+				acn[acn.index, ] <- 0

+			}

 		}

 		if(is.ff){

 			close(nuB(object))

@@ -192,8 +192,6 @@ The \Rfunction{crlmmCopynumber} performs the following steps:

 GT.CONF.THR <- 0.90

 cnSet <- checkExists("cnSet", .path=outdir, .FUN=crlmmCopynumber, object=gtSet, GT.CONF.THR=GT.CONF.THR)

 invisible(open(cnSet))

-q("no")

-stop("here")

 @

 In an effort to reduce I/O, the \Rpackage{crlmmCopynumber} function no

@@ -222,7 +220,7 @@ the useful accessors for extracting which markers are SNPs, which are

 chromosomes, etc.

 <<ca>>=

-snp.index <- which(isSnp(cnSet))

+snp.index <- which(isSnp(cnSet) & chromosome(cnSet) < 23)

 ca <- CA(cnSet, i=snp.index, j=1:5)

 cb <- CB(cnSet, i=snp.index, j=1:5)

 ct <- ca+cb

@@ -239,7 +237,7 @@ At nonpolymorphic loci, either the \Rfunction{CA} or

 of total copy number.

 <<nonpolymorphicAutosomes>>=

-marker.index <- which(!isSnp(cnSet) & chromosome(cnSet) < 23)

+marker.index <- which(!isSnp(cnSet))

 ct <- CA(cnSet, i=marker.index, j=1:5)

 ## all zeros

 stopifnot(all(CB(cnSet, i=marker.index, j=1:5) == 0))

@@ -249,20 +247,27 @@ stopifnot(all.equal(ct, ct2))

 Nonpolymorphic markers on X:

+\begin{figure}

+  \centering

 <<nonpolymorphicX>>=

-## nu and phi are not estimated appropriately for nonpolymorphic X markers.

 library(RColorBrewer)

 cols <- brewer.pal(8, "Paired")[3:4]

 cols <- rep(cols, each=5)

-##set.seed(123)

-X.markers <- sample(which(!isSnp(cnSet) & chromosome(cnSet) == 23), 20e3)

-cn.M <- CA(cnSet, i=X.markers, j=sample(which(cnSet$gender==1), 5))

-cn.F <- CA(cnSet, i=X.markers, j=sample(which(cnSet$gender==2), 5))

-##phi(cnSet, "A")[X.markers[1:10]]

+set.seed(123)

+X.markers <- sample(which(chromosome(cnSet)==23 & !isSnp(cnSet)), 10e3)

+M <- sample(which(cnSet$gender==1), 5)

+F <- sample(which(cnSet$gender==2), 5)

+cn.M <- CA(cnSet, i=X.markers, j=M)

+cn.F <- CA(cnSet, i=X.markers, j=F)

 boxplot(data.frame(cbind(cn.M, cn.F)), pch=".", xaxt="n", main="nonpolymorphic markers on X",

-	col=cols)

+	col=cols, ylim=c(0,5))

 legend("topleft", fill=unique(cols), legend=c("Male", "Female"))

 @

+\caption{Copy number estimates for nonpolymorphic markers on

+  chromosome X.  We assume that the median copy number (across

+  samples) at any given nonpolymorphic marker on chromosome X is 1 for

+  males and 2 for females.}

+\end{figure}

 Polymorphic markers, X chromosome:

@@ -270,98 +275,24 @@ Polymorphic markers, X chromosome:

 \begin{figure}

   \centering

 <<polymorphicX, fig=TRUE, width=8, height=4>>=

-## copy number estimates on X for SNPs are biased towards small values.

 X.markers <- sample(which(isSnp(cnSet) & chromosome(cnSet) == 23), 25e3)

-

-##genomewidesnp6Crlmm is correct.  FeatureData is incorrect.

-index <- match(featureNames(cnSet), rownames(snpProbes))

-sum(snpProbes[index, "chrom"] != chromosome(cnSet))

-

-M <- sample(which(cnSet$gender==1), 5)

-F <- sample(which(cnSet$gender==2), 5)

-

-fns <- list.files("~/hapmap_metadata", full.names=T)

-dat <- read.delim(fns[2])

-sns <- substr(sampleNames(cnSet), 1, 7)

-dat <- dat[match(sns, dat$IID), ]

-stopifnot(all.equal(as.character(dat$IID), sns))

-identical(cnSet$gender, dat$sex)

-

-cols <- brewer.pal(8, "Paired")[3:4]

-cols <- cols[cnSet$gender]

-ia <- A(cnSet)[X.markers, ]##c(M, F)]

-ib <- B(cnSet)[X.markers, ]##c(M, F)]

-i.total <- ia+ib

-boxplot(data.frame(log2(i.total)), pch=".", col=cols)

-legend("topleft", fill=unique(cols), legend=c("Male", "Female"))

-

-nus <- nuA(cnSet)[X.markers, ]

-phiss <- phiA(cnSet)[X.markers, ]

-

-

-xSet <- cnSet[X.markers, ]

-a <- as.matrix(A(xSet))

-b <- as.matrix(B(xSet))

-gt <- as.matrix(calls(xSet))

-nuA <- nu(xSet, "A")

-phA <- phi(xSet, "A")

-col <- brewer.pal(7, "Accent")[c(1, 4, 7)]

-fns.xset <- featureNames(xSet)

-

-path <- system.file("extdata", package="genomewidesnp6Crlmm")

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

-index <- match(fns.xset, rownames(snpProbes))

-all(snpProbes[index, "chrom"]==23)

-

-pkg <- "pd.genomewidesnp.6"

-library(pd.genomewidesnp.6)

-conn <- db(get(pkg))

-sql <- "SELECT man_fsetid, chrom, physical_pos FROM featureSet"

-snps <- dbGetQuery(conn, sql)

-index <- match(fns.xset, snps$man_fsetid)

-all(snps$chrom[index] == "X")

-

-## are we writing intensities to the wrong location??

-

-

-

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

-### chunk number 25: ABscatterplots

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

-#line 599 "manuscript.Rnw"

-lA <- log2(a)

-lB <- log2(b)

-cols <- c("blue", "black", "red")

-par(las=1, mfrow=c(4,4), mar=rep(0.5,4), oma=c(4,4, 4,4))

-for(i in 1:16){

-	plot(lB[i, ], lA[i, ], col="grey50", bg=col[gt[i, ]], xaxt="n", yaxt="n", pch=21, cex=0.8,

-	     xlim=c(6.5, 12.5), ylim=c(6.5, 12.5), xlab="", ylab="")

-	for(CN in 1:3) 	lines(xSet, i, "GIGAS", CN, col=cols[CN], lwd=2, x.axis="B")

-}

-mtext(expression(log[2](I[B])), 1, outer=TRUE)

-par(las=3)

-mtext(expression(log[2](I[A])), 2, outer=TRUE)

-

-

-

-boxplot(data.frame(ia+ib), pch=".", col=cols)

-trace(ACN, browser)

-trace(C3, browser)

 ca.M <- CA(cnSet, i=X.markers, j=M)

 cb.M <- CB(cnSet, i=X.markers, j=M)

 ca.F <- CA(cnSet, i=X.markers, j=F)

 cb.F <- CB(cnSet, i=X.markers, j=F)

 cn.M <- ca.M+cb.M

 cn.F <- ca.F+cb.F

-tmp <- totalCopynumber(cnSet, i=X.markers, j=c(M, F))

-boxplot(data.frame(cbind(cn.M, cn.F)), pch=".", outline=FALSE, col=cols, xaxt="n")

-boxplot(data.frame(tmp), pch=".", outline=FALSE, col=cols, xaxt="n")

+boxplot(data.frame(cbind(cn.M, cn.F)), pch=".", outline=FALSE, col=cols, xaxt="n", ylim=c(0,5))

+legend("topleft", fill=unique(cols), legend=c("Male", "Female"))

 abline(h=c(1,2))

 ## alternatively

 cn.F2 <- totalCopynumber(cnSet, i=X.markers, j=F)

 stopifnot(all.equal(cn.F, cn.F2))

 @

-\caption{Copy number estimates for polymorphic markers on chromosome X}

+\caption{Copy number estimates for polymorphic markers on chromosome

+  X.  We assume that the median copy number (across samples) at any

+  given polymorphic marker on chromosome X is 1 for males and 2 for

+  females.}

 \end{figure}

 Accessors for physical position and chromosome are also provided. In

@@ -441,7 +372,7 @@ rows <- which(isSnp(cnSet))

 cols <- which(batch == "C")

 posterior.prob <- tryCatch(i2p(snpCallProbability(cnSet)),

 			   error=function(e) print("This will not work for an ff object."))

-posterior.prob2 <- p2i(snpCallProbability(cnSet)[rows, cols])

+##posterior.prob2 <- p2i(snpCallProbability(cnSet)[rows, cols])

 @

 Accessors for the quantile normalized intensities for the A allele at

@@ -450,6 +381,7 @@ polymorphic loci:

 <<accessors>>=

 snp.index <- which(isSnp(cnSet))

 np.index <- which(!isSnp(cnSet))

+invisible(open(A(cnSet)))

 a <- (A(cnSet))[snp.index, ]

 dim(a)

 @

@@ -468,11 +400,13 @@ obtained by:

 <<>>=

 npIntensities <- (A(cnSet))[np.index, ]

+invisible(close(A(cnSet)))

 @

 Quantile normalized intensities for the B allele at polymorphic loci:

 <<B.polymorphic>>=

+invisible(open(B(cnSet)))

 b.snps <- (B(cnSet))[snp.index, ]

 @

@@ -481,6 +415,7 @@ nonpolymorphic loci:

 <<B.NAs>>=

 all(is.na((B(cnSet))[np.index, ]))

+invisible(close(B(cnSet)))

 @

 <<clean, echo=FALSE>>=

@@ -538,7 +473,7 @@ cn <- totalCopynumber(cnSet, i=marker.index, j=1)

 x <- position(cnSet)[marker.index]

 par(las=1, mar=c(4, 5, 4, 2))

 plot(x, cn, pch=".",

-     cex=2, xaxt="n", col="grey60", ylim=c(0,4),

+     cex=2, xaxt="n", col="grey60", ylim=c(0,6),

      ylab="copy number", xlab="physical position (Mb)",

      main=paste(sampleNames(cnSet)[1], ", CHR: 1"))

 ##np.index <- which(!isSnp(cnSet)[marker.index])

@@ -546,7 +481,7 @@ plot(x, cn, pch=".",

 ##       pch=".", cex=2, col="lightblue")

 axis(1, at=pretty(x), labels=pretty(x)/1e6)

 require(SNPchip)

-invisible(plotCytoband(1, new=FALSE, cytoband.ycoords=c(3.8, 4), label.cytoband=FALSE))

+invisible(plotCytoband(1, new=FALSE, cytoband.ycoords=c(5.3, 5.9), label.cytoband=FALSE))

 @

 \begin{figure}

@@ -595,7 +530,9 @@ the threshold specified in \Robject{crlmmCopynumber}.

 <<NAconfidenceScores>>=

 if(nmissing.ca > 0){

+	invisible(open(snpCallProbability(cnSet)))

 	gt.conf <- i2p(snpCallProbability(cnSet)[autosome.index, sample.index])

+	invisible(close(snpCallProbability(cnSet)))

 	below.thr <- gt.conf < GT.CONF.THR

 	index.allbelow <- as.integer(which(rowSums(below.thr) == length(sample.index)))

 	all.equal(index, index.allbelow)

@@ -628,7 +565,9 @@ that were all below the threshold.

 <<NAcrlmmConfidenceScore>>=

 if(nmissing.caX > 0){

+	invisible(open(snpCallProbability(cnSet)))

 	gt.conf <- i2p(snpCallProbability(cnSet)[X.index, sample.index])

+	invisible(close(snpCallProbability(cnSet)))

 	below.thr <- gt.conf < GT.CONF.THR

 	F <- which(cnSet$gender[sample.index] == 2)

 	M <- which(cnSet$gender[sample.index] == 1)

@@ -671,9 +610,9 @@ included as a parameter for the copy number estimation as an approach

 to reduce the sensitivity of genotype-specific summary statistics,

 such as the within-genotype median, to intensities from samples that

 do not clearly fall into one of the biallelic genotype clusters. There

-are drawbacks to this approach, including variance estimates that are

-overly optimistic.  More direct approaches for outlier detection and

-removal may be explored in the future.

+are drawbacks to this approach, including variance estimates that can

+be a bit optimistic at some loci.  More direct approaches for outlier

+detection and removal may be explored in the future.

 Copy number estimates for other chromosomes, such as mitochondrial and

 chromosome Y, are not currently available in \crlmm{}.

Binary files a/inst/scripts/copynumber.pdf and b/inst/scripts/copynumber.pdf differ