@@ -1,4 +1,5 @@

 auto*

+ModelForPolymorphicX.pdf

 .Rhistory

 *.o

 *.so

@@ -1,6 +1,6 @@

 useDynLib("crlmm", .registration=TRUE)

 ## this is temporary

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

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

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

 ## Biobase

@@ -118,16 +118,13 @@ genotype <- function(filenames,

 			     sns=sns,

 			     verbose=verbose,

 			     batch=batch)

-	if(is.lds) open(callSet)

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

-	is.snp <- isSnp(callSet)

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

 	FUN <- ifelse(is.lds, "snprma2", "snprma")

 	snprmaFxn <- function(FUN,...){

 		switch(FUN,

 		       snprma=snprma(...),

 		       snprma2=snprma2(...))

 	}

+

 	snprmaRes <- snprmaFxn(FUN,

 			       filenames=filenames,

 			       mixtureSampleSize=mixtureSampleSize,

@@ -137,6 +134,15 @@ genotype <- function(filenames,

 			       seed=seed,

 			       cdfName=cdfName,

 			       sns=sns)

+	gns <- snprmaRes[["gns"]]

+	snp.I <- isSnp(callSet)

+	is.snp <- which(snp.I)

+	snp.index <- match(featureNames(callSet)[is.snp], gns)

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

+##	is.snp <- isSnp(callSet)

+##	snp.index <- which(is.snp)

+	if(is.lds) open(callSet)

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

 	##message("Saving snprmaRes file")

 	##save(snprmaRes, file=file.path(outdir, "snprmaRes.rda"))

 	if(verbose) message("Finished preprocessing.")

@@ -147,17 +153,21 @@ genotype <- function(filenames,

 		open(snprmaRes[["mixtureParams"]])

 		##bb <- getOption("ffbatchbytes")

 		message("Writing normalized intensities to callSet")

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

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

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

 	} else{

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

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

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

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

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

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

 	}

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

+	np.index <- which(!snp.I)

 	FUN <- ifelse(is.lds, "cnrma2", "cnrma")

 	## main purpose is to update 'alleleA'

 	cnrmaFxn <- function(FUN,...){

@@ -203,11 +213,15 @@ genotype <- function(filenames,

 	if(is.lds){

 		open(tmp[["calls"]])

 		open(tmp[["confs"]])

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

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

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

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

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

 	}

 	message("Finished updating.  Cleaning up.")

 	callSet$gender <- tmp$gender

@@ -816,9 +830,9 @@ fit.lm3 <- function(strata,

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

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

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

-		phiA2[phiA2 < MIN.PHI] <- MIN.PHI

+		phiA2[phiA2 < 1] <- 1

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

-		phiB2[phiB2 < MIN.PHI] <- MIN.PHI

+		phiB2[phiB2 < 1] <- 1

 	}

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

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

@@ -958,7 +972,6 @@ cnrma <- function(A, filenames, row.names, verbose=TRUE, seed=1, cdfName, sns){

 	if(verbose) message("Loading annotations for nonpolymorphic probes")

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

 	fid <- getVarInEnv("npProbesFid")

-

 	if(cdfName=="genomewidesnp6"){

 		loader("1m_reference_cn.rda", .crlmmPkgEnv, pkgname)

 	}

@@ -1798,7 +1811,7 @@ crlmmCopynumber <- function(object,

 	samplesPerBatch <- table(as.character(batch(object)))

 	if(any(samplesPerBatch < MIN.SAMPLES)){

 		warning("The following batches have fewer than ", MIN.SAMPLES, ":")

-		message(paste(samplesPerBatch[samplesPerBatch < MIN.SAMPLES], collapse=", "))

+		message(paste(names(samplesPerBatch)[samplesPerBatch < MIN.SAMPLES], collapse=", "))

 		message("Not estimating copy number for the above batches")

 	}

 	mylabel <- function(marker.type){

@@ -364,14 +364,16 @@ C3 <- function(object, allele, marker.index, batch.index, sample.index){

 		phiA <- phiA(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 <- tmp/(1-phistar*phiA2/phiB)

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

 		if(allele == "B"){

 			acn[[k]] <- CB

 		}

 		if(allele == "A"){

-			acn[[k]] <- (IA-nuA-phiA2*CB)/phiA

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

+			acn[[k]] <- ca

 		}

 		if(allele == "AandB"){

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

@@ -25,7 +25,7 @@ testingFF: testingFF.Rnw

 	qsub -m e -r y -cwd -l mem_free=12G,h_vmem=16G testingFF.R.sh

 affy:	copynumber.Rnw

-	echo "Stangle(\"copynumber.Rnw\")" | R --no-save --no-restore;	

+	echo "Stangle(\"copynumber.Rnw\")" | R-devel --no-save --no-restore;	

 	cat ~/bin/cluster.template | perl -pe "s/Rprog/copynumber.R/" > copynumber.R.sh

 	qsub -m e -r y -cwd -l mem_free=12G,h_vmem=16G copynumber.R.sh

@@ -52,7 +52,7 @@ separately) that are listed below.

 <<annotationPackages>>=

 pkgs <- annotationPackages()

-pkgs <- pgks[grep("Crlmm", pkgs)]

+pkgs <- pkgs[grep("Crlmm", pkgs)]

 pkgs

 @

@@ -157,6 +157,7 @@ be run interactively.

 <<LDS_genotype>>=

 if(!file.exists(file.path(outdir, "cnSet.rda"))){

+	##trace(genotype, browser)

 	gtSet <- checkExists("gtSet",

 			     .path=outdir,

 			     .FUN=genotype,

@@ -190,6 +191,9 @@ The \Rfunction{crlmmCopynumber} performs the following steps:

 <<LDS_copynumber>>=

 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

@@ -243,15 +247,21 @@ ct2 <- totalCopynumber(cnSet, i=marker.index, j=1:5)

 stopifnot(all.equal(ct, ct2))

 @

-TODO: FIX estimation for nonpolymorphic markers on X

+Nonpolymorphic markers on X:

-<<nonpolymorphicX, eval=FALSE>>=

+<<nonpolymorphicX>>=

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

-X.markers <- which(!isSnp(cnSet) & chromosome(cnSet) == 23)

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

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

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

-boxplot(data.frame(cbind(cn.M, cn.F)), pch=".")

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

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

+	col=cols)

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

 @

@@ -261,17 +271,94 @@ Polymorphic markers, X chromosome:

   \centering

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

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

-X.markers <- which(isSnp(cnSet) & chromosome(cnSet) == 23)

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

-cb.M <- CB(cnSet, i=X.markers, j=which(cnSet$gender==1))

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

-cb.F <- CB(cnSet, i=X.markers, j=which(cnSet$gender==2))

+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

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

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

 abline(h=c(1,2))

 ## alternatively

-cn.F2 <- totalCopynumber(cnSet, i=X.markers, j=which(cnSet$gender==2))

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

@@ -588,6 +675,13 @@ 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.

+Copy number estimates for other chromosomes, such as mitochondrial and

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

+

+<<echo=FALSE>>=

+invisible(close(cnSet))

+@

+

 \section{Session information}

 <<sessionInfo, results=tex>>=

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