Commit information:
Commit id: 736588e3d47fd58358f61ce2241bb2c85b4d9a0c
update to vignette to process previously unevaluated codechunks
Committed by: Rob Scharpf
Author Name: Rob Scharpf
Commit date: 2014-09-19 10:14:04 -0400
Author date: 2014-09-19 10:14:04 -0400
git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@94285 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -2,8 +2,8 @@ Package: crlmm |
2 | 2 |
Type: Package |
3 | 3 |
Title: Genotype Calling (CRLMM) and Copy Number Analysis tool for |
4 | 4 |
Affymetrix SNP 5.0 and 6.0 and Illumina arrays. |
5 |
-Version: 1.23.2 |
|
6 |
-Date: Mon Aug 25 21:43:53 EDT 2014 |
|
5 |
+Version: 1.23.3 |
|
6 |
+Date: Fri Sep 19 10:10:31 EDT 2014 |
|
7 | 7 |
Author: Benilton S Carvalho, Robert Scharpf, Matt Ritchie, Ingo |
8 | 8 |
Ruczinski, Rafael A Irizarry |
9 | 9 |
Maintainer: Benilton S Carvalho <Benilton.Carvalho@cancer.org.uk>, |
... | ... |
@@ -681,7 +681,7 @@ setMethod(OligoSetList, "CNSet", function(object,...){ |
681 | 681 |
constructOligoSetListFrom(object, ...) |
682 | 682 |
}) |
683 | 683 |
setMethod(BafLrrSetList, "CNSet", function(object,...){ |
684 |
- constructBafLrrSetListFrom(object, ...) |
|
684 |
+ constructBafLrrSetListFrom(object, ...) |
|
685 | 685 |
}) |
686 | 686 |
|
687 | 687 |
|
... | ... |
@@ -689,41 +689,41 @@ setMethod(BafLrrSetList, "CNSet", function(object,...){ |
689 | 689 |
|
690 | 690 |
|
691 | 691 |
constructOligoSetListFrom <- function(object, ...){ |
692 |
- ##row.index <- seq_len(nrow(object)) |
|
693 |
- ##col.index <- seq_len(ncol(object)) |
|
694 |
- is.lds <- ifelse(is(calls(object), "ff_matrix") | is(calls(object), "ffdf"), TRUE, FALSE) |
|
695 |
- if(is.lds) stopifnot(isPackageLoaded("ff")) |
|
696 |
- b.r <- calculateRBaf(object, ...) |
|
697 |
- b <- b.r[["baf"]] |
|
698 |
- r <- b.r[["lrr"]] |
|
699 |
- j <- match(colnames(r[[1]]), sampleNames(object)) |
|
700 |
- rns <- lapply(r, rownames) |
|
701 |
- fDList <- foreach(featureid=rns) %do%{ |
|
702 |
- featureData(object)[match(featureid, featureNames(object)), ] |
|
703 |
- } |
|
704 |
- names(fDList) <- sapply(fDList, function(x) chromosome(x)[1]) |
|
705 |
- gtPlist <- gtlist <- vector("list", length(r)) |
|
706 |
- for(i in seq_along(r)){ |
|
707 |
- gtlist[[i]] <- initializeBigMatrix("call", nr=nrow(r[[i]]), nc=length(j), vmode="integer") |
|
708 |
- gtPlist[[i]] <- initializeBigMatrix("callPr", nr=nrow(r[[i]]), nc=length(j), vmode="integer") |
|
709 |
- featureid <- rownames(r[[i]]) |
|
710 |
- ix <- match(featureid, featureNames(object)) |
|
711 |
- rownames(gtPlist[[i]]) <- rownames(gtlist[[i]]) <- featureid |
|
712 |
- colnames(gtPlist[[i]]) <- colnames(gtlist[[i]]) <- colnames(r[[i]]) |
|
713 |
- for(k in seq_along(j)){ |
|
714 |
- gtlist[[i]][, k] <- calls(object)[ix, j[k]] |
|
715 |
- gtPlist[[i]][, k] <- snpCallProbability(object)[ix, j[k]] |
|
716 |
- } |
|
717 |
- } |
|
718 |
- ad <- AssayDataList(baf=b, copyNumber=r, call=gtlist, callProbability=gtPlist) |
|
719 |
- object <- new("oligoSetList", |
|
720 |
- assayDataList=ad, |
|
721 |
- featureDataList=fDList, |
|
722 |
- chromosome=names(fDList), |
|
723 |
- phenoData=phenoData(object)[j, ], |
|
724 |
- annotation=annotation(object), |
|
725 |
- genome=genomeBuild(object)) |
|
726 |
- return(object) |
|
692 |
+ ##row.index <- seq_len(nrow(object)) |
|
693 |
+ ##col.index <- seq_len(ncol(object)) |
|
694 |
+ is.lds <- ifelse(is(calls(object), "ff_matrix") | is(calls(object), "ffdf"), TRUE, FALSE) |
|
695 |
+ if(is.lds) stopifnot(isPackageLoaded("ff")) |
|
696 |
+ b.r <- calculateRBaf(object, ...) |
|
697 |
+ b <- b.r[["baf"]] |
|
698 |
+ r <- b.r[["lrr"]] |
|
699 |
+ j <- match(colnames(r[[1]]), sampleNames(object)) |
|
700 |
+ rns <- lapply(r, rownames) |
|
701 |
+ fDList <- foreach(featureid=rns) %do%{ |
|
702 |
+ featureData(object)[match(featureid, featureNames(object)), ] |
|
703 |
+ } |
|
704 |
+ names(fDList) <- sapply(fDList, function(x) chromosome(x)[1]) |
|
705 |
+ gtPlist <- gtlist <- vector("list", length(r)) |
|
706 |
+ for(i in seq_along(r)){ |
|
707 |
+ gtlist[[i]] <- initializeBigMatrix("call", nr=nrow(r[[i]]), nc=length(j), vmode="integer") |
|
708 |
+ gtPlist[[i]] <- initializeBigMatrix("callPr", nr=nrow(r[[i]]), nc=length(j), vmode="integer") |
|
709 |
+ featureid <- rownames(r[[i]]) |
|
710 |
+ ix <- match(featureid, featureNames(object)) |
|
711 |
+ rownames(gtPlist[[i]]) <- rownames(gtlist[[i]]) <- featureid |
|
712 |
+ colnames(gtPlist[[i]]) <- colnames(gtlist[[i]]) <- colnames(r[[i]]) |
|
713 |
+ for(k in seq_along(j)){ |
|
714 |
+ gtlist[[i]][, k] <- calls(object)[ix, j[k]] |
|
715 |
+ gtPlist[[i]][, k] <- snpCallProbability(object)[ix, j[k]] |
|
716 |
+ } |
|
717 |
+ } |
|
718 |
+ ad <- AssayDataList(baf=b, copyNumber=r, call=gtlist, callProbability=gtPlist) |
|
719 |
+ object <- new("oligoSetList", |
|
720 |
+ assayDataList=ad, |
|
721 |
+ featureDataList=fDList, |
|
722 |
+ chromosome=names(fDList), |
|
723 |
+ phenoData=phenoData(object)[j, ], |
|
724 |
+ annotation=annotation(object), |
|
725 |
+ genome=genomeBuild(object)) |
|
726 |
+ return(object) |
|
727 | 727 |
} |
728 | 728 |
|
729 | 729 |
|
... | ... |
@@ -77,7 +77,8 @@ the path indicated by \verb+outdir+. |
77 | 77 |
|
78 | 78 |
<<setup>>= |
79 | 79 |
pathToCels <- "/thumper/ctsa/snpmicroarray/hapmap/raw/affy/1m" |
80 |
-outdir <- paste("/local_data/r00/crlmm/", getRversion(), "/affy_vignette", sep="") |
|
80 |
+v <- paste0("crlmm_v", gsub("\\.", "_", packageDescription("crlmm")$Version)) |
|
81 |
+outdir <- file.path("/thumper/ctsa/snpmicroarray/rs/ProcessedData", v) |
|
81 | 82 |
dir.create(outdir, recursive=TRUE, showWarnings=FALSE) |
82 | 83 |
@ |
83 | 84 |
|
... | ... |
@@ -200,8 +200,7 @@ Estimation of log R ratios and B allele frequencies from an object of class \Rcl |
200 | 200 |
crlmmCopynumber(cnSet, fit.linearModel=FALSE) |
201 | 201 |
@ |
202 | 202 |
|
203 |
-<<oligoSnpSet,eval=FALSE>>= |
|
204 |
-library(VanillaICE) |
|
203 |
+<<oligoSnpSet>>= |
|
205 | 204 |
open(cnSet) |
206 | 205 |
oligoSetList <- BafLrrSetList(cnSet) |
207 | 206 |
close(cnSet) |
... | ... |
@@ -214,7 +213,7 @@ oligoSetList[[1]] |
214 | 213 |
\noindent Log R ratios and B allele frequences can be retrieved by the |
215 | 214 |
accessors \Rfunction{lrr} and \Rfunction{baf}, respectively. |
216 | 215 |
|
217 |
-<<testEqual,eval=FALSE>>= |
|
216 |
+<<testEqual>>= |
|
218 | 217 |
lrrList <- lrr(oligoSetList) |
219 | 218 |
class(lrrList) |
220 | 219 |
dim(lrrList[[1]]) ## log R ratios for chromosome 1. |