Browse code

Added nopackage option for krlmm

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@117087 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 03/05/2016 23:39:54
Showing1 changed files
... ...
@@ -173,7 +173,8 @@ illuminaCdfNames <- function(){
173 173
 	  "humanimmuno12v1b",       # Immuno chip 12
174 174
 	  "humancytosnp12v2p1h",    # CytoSNP 12
175 175
           "humanexome12v1p2a",      # Exome 12 v1.2 A
176
-          "humanomniexpexome8v1p1b")
176
+          "humanomniexpexome8v1p1b",
177
+          "nopackage")
177 178
 }
178 179
 
179 180
 affyCdfNames <- function(){
Browse code

Added support for humanexome12v1.2a chip

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@94521 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 25/09/2014 11:06:52
Showing1 changed files
... ...
@@ -172,6 +172,7 @@ illuminaCdfNames <- function(){
172 172
 	  "humanomniexpress12v1b",  # Omni express 12
173 173
 	  "humanimmuno12v1b",       # Immuno chip 12
174 174
 	  "humancytosnp12v2p1h",    # CytoSNP 12
175
+          "humanexome12v1p2a",      # Exome 12 v1.2 A
175 176
           "humanomniexpexome8v1p1b")
176 177
 }
177 178
 
Browse code

Changes to krlmm to avoid error that occurs in k-means clustering when all intensities are identical

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@88225 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 01/04/2014 02:51:49
Showing1 changed files
... ...
@@ -166,7 +166,8 @@ illuminaCdfNames <- function(){
166 166
 	  "human1mduov3b",          # 1M Duo
167 167
 	  "humanomni1quadv1b",      # Omni1 quad
168 168
 	  "humanomni25quadv1b",     # Omni2.5 quad
169
-	  "humanomni258v1a",        # Omni2.5 8
169
+	  "humanomni258v1a",        # Omni2.5 8 v1 A
170
+          "humanomni258v1p1b",      # Omni2.5 8 v1.1 B
170 171
           "humanomni5quadv1b",      # Omni5 quad          
171 172
 	  "humanomniexpress12v1b",  # Omni express 12
172 173
 	  "humanimmuno12v1b",       # Immuno chip 12
Browse code

merging from collab

* collab:
add warning in vignette about NAs with BafLrrSetList function
Added Human Omni Express Exome 8 v1.1b as a supported chip
updated version number of pacakge and man pages to reflect these changes
skeleton for krlmm capability added. genotype.Illumina() can now take and XY object as input
update copynumber.Rnw to use BafLrrSetList
updates to vignettes
update namespace

# Please enter a commit message to explain why this merge is necessary,
# especially if it merges an updated upstream into a topic branch.
#
# Lines starting with '#' will be ignored, and an empty message aborts
# the commit.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@79138 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 31/07/2013 01:37:34
Showing1 changed files
... ...
@@ -166,10 +166,12 @@ illuminaCdfNames <- function(){
166 166
 	  "human1mduov3b",          # 1M Duo
167 167
 	  "humanomni1quadv1b",      # Omni1 quad
168 168
 	  "humanomni25quadv1b",     # Omni2.5 quad
169
-	  "humanomni258v1a",        # Omni2.5 8 sample
169
+	  "humanomni258v1a",        # Omni2.5 8
170
+          "humanomni5quadv1b",      # Omni5 quad          
170 171
 	  "humanomniexpress12v1b",  # Omni express 12
171 172
 	  "humanimmuno12v1b",       # Immuno chip 12
172
-	  "humancytosnp12v2p1h")    # CytoSNP 12
173
+	  "humancytosnp12v2p1h",    # CytoSNP 12
174
+          "humanomniexpexome8v1p1b")
173 175
 }
174 176
 
175 177
 affyCdfNames <- function(){
Browse code

merge with collab branch containing fix for dqrls and bug-fix for computeRBaf that can misalign sample index with batch index (when batch is not in alphabetical order)

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@71295 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 17/11/2012 15:24:46
Showing1 changed files
... ...
@@ -14,8 +14,11 @@ getCrlmmAnnotationName <- function(x){
14 14
 	paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
15 15
 }
16 16
 
17
+## medianSummaries <- function(mat, grps)
18
+##   .Call("R_subColSummarize_median", mat, grps, PACKAGE = "preprocessCore")
19
+
17 20
 medianSummaries <- function(mat, grps)
18
-  .Call("R_subColSummarize_median", mat, grps, PACKAGE = "preprocessCore")
21
+.Call("subColSummarizeMedianPP", mat, grps)
19 22
 
20 23
 intMedianSummaries <- function(mat, grps)
21 24
   as.integer(medianSummaries(mat, grps))
Browse code

Merge branch 'collab'

* collab:
Update CNSet objects in data/ with datadir slot and protocolData(object)$filename
update cnrmaAffy. processCEL2 located inside cnrmaAffy function. Uses lexical scope.
Change API for genotypeAffy -- remove mixtureParams argument. Update call to genotypeAffy in genotype function
snprmaAffy no longer initializes mixtureParams object, but accesses this information from the cnSet
constructAffyCNSet initializes mixtureParams slot of the appropriate dimensions
updated cnrmaAffy. Removed cnrma2, cnrma. cnrmaAffy uses lexical scope
Fix bug in crlmmGT2 caused by unequal batch sizes
Moved rsprocessCel inside of snprmaAffy for lexical scope. Moved imputeGender inside crlmmGT2 for lexical scope
Revert imputeGender to original approach for crlmm. Splitting samples across nodes does not work well if there are not a lot of samples in the individual nodes. Probably better to use fewer markers on chr X when large number of samples are processed
contains old process1 call
change gender <- unlist(gender) to gender <- unlist(genderList)
v1.15.15 Fix memory leak in imputeGender step by running this function in sample batches of size ocSamples(). Use lexical scope in calling process1 function in crlmmGT2.
set default values in summarizeNps
depends on v 1.19.39 of oligoClasses
v1.15.14: Export constructAffyCNSet. Used datadir slot in CNSet object added to v 1.19.39 of oligoClasses
update getFeatureData for use with annotation package that contains a number of SNPs not necessarily included in the genotyping. These additional snps are removed when constructing the featureData in constructAffy

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@67826 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 19/07/2012 03:57:08
Showing1 changed files
... ...
@@ -11,7 +11,7 @@ changeToCrlmmAnnotationName <- function(x){
11 11
 }
12 12
 
13 13
 getCrlmmAnnotationName <- function(x){
14
-  paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
14
+	paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
15 15
 }
16 16
 
17 17
 medianSummaries <- function(mat, grps)
Browse code

Merge branch 'collab'

* collab: (34 commits)
revert change to IlluminaPreprocessCN
fix bug in isValidCdfName
print warning when all features in a batch of probes are flagged, but allow processing to continue
add utility cleancdfnames
Add validCdfNames.Rd
export validCdfNames
imputeGender fix when chromosome Y not available
Use splitIndicesByLength(index, ocSamples/getDoParWorkers())
Can not allocate vector of size XG with genotype.Illumina. Use splitIndicesByNode() only if the length of the list is greater than the split from splitIndicesByLength(). Otherwise, split by length using ocSamples()
update .gitignore
Add make.unique for sampleSheet$Sample_ID in readIdatFiles
bug in description
ensure sample ids stored in samplesheet are unique when constructing cnSet object
update oligoClasses dependency
update unit test for genotype.Illumina
revert change in constructInf call from genotype.Illumina
Update genotype.Rd
edit ACN function
1.15.6 use make.unique(basename(arrayNames)) to allow processing of Illumina samples with duplicated barcodes
check that sample identifies are unique in crlmm function
...

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@67435 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 08/07/2012 19:00:03
Showing1 changed files
... ...
@@ -152,30 +152,39 @@ celDates <- function(celfiles){
152 152
 	return(celdts)
153 153
 }
154 154
 
155
-validCdfNames <- function(){
155
+illuminaCdfNames <- function(){
156
+	c("human1mv1c",# 1M
157
+	  "human370v1c",            # 370CNV
158
+	  "human650v3a",            # 650Y
159
+	  "human610quadv1b",        # 610 quad
160
+	  "human660quadv1a",        # 660 quad
161
+	  "human370quadv3c",        # 370CNV quad
162
+	  "human550v3b",            # 550K
163
+	  "human1mduov3b",          # 1M Duo
164
+	  "humanomni1quadv1b",      # Omni1 quad
165
+	  "humanomni25quadv1b",     # Omni2.5 quad
166
+	  "humanomni258v1a",        # Omni2.5 8 sample
167
+	  "humanomniexpress12v1b",  # Omni express 12
168
+	  "humanimmuno12v1b",       # Immuno chip 12
169
+	  "humancytosnp12v2p1h")    # CytoSNP 12
170
+}
171
+
172
+affyCdfNames <- function(){
156 173
 	c("genomewidesnp6",
157
-	  "genomewidesnp5",
158
-	  "human370v1c",
159
-	  "human370quadv3c",
160
-	  "human550v3b",
161
-	  "human650v3a",
162
-	  "human610quadv1b",
163
-	  "human660quadv1a",
164
-	  "human1mduov3b",
165
-	  "humanomni1quadv1b",
166
-          "humanomniexpress12v1b",
167
-	  "humanomni25quadv1b",
168
-          "humanimmuno12v1b",
169
-          "humancytosnp12v2p1h")
174
+	  "genomewidesnp5")
170 175
 }
176
+
177
+validCdfNames <- function(){
178
+	c(affyCdfNames(),
179
+	  illuminaCdfNames())
180
+}
181
+
182
+cleancdfname <- function(x) strsplit(x, "Crlmm")[[1]][[1]]
183
+
171 184
 isValidCdfName <- function(cdfName){
172 185
 	chipList <- validCdfNames()
173
-	result <- cdfName %in% chipList
174
-	if(!(result)){
175
-		warning("cdfName must be one of the following: ",
176
-			chipList)
177
-	}
178
-	return(result)
186
+	match.arg(cleancdfname(cdfName), chipList)
187
+	return(TRUE)
179 188
 }
180 189
 
181 190
 isPackageLoaded <- function(pkg){
Browse code

Merge branch 'collab'

* collab:
bump version
made cnSetExample smaller. Fix notes
Trying to revert bad commit
remove cn-functions. update description
comment most of cn-functions.r
Resaved rdas
update data/cnSetExample.rda and data/cnSetExample2.rda
bump version
coercion method from CNSet to oligoSnpSet makes integer matrices of BAFs and lrr's
import ff_or_matrix from oligoClasses. bump dependency on oligoClasses version. Use library(oligoClasses) in some of the crlmm examples.
Cleaning pkg loading process: work still required
move Biobase and methods to imports

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@64324 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 23/03/2012 03:34:50
Showing1 changed files
... ...
@@ -214,7 +214,7 @@ setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatr
214 214
 
215 215
 ## Document this...
216 216
 getBAF <- function(theta, canonicalTheta)
217
-    .Call('normalizeBAF', theta, ct)
217
+    .Call('normalizeBAF', theta, canonicalTheta)
218 218
 
219 219
 
220 220
 validCEL <- function(celfiles){
Browse code

Merge branch 'mymac'

* mymac:
add AffyGW.pdf
update vignettes in inst/scripts
Change argument of validCEL to celfiles
Update constructInf to accommodate GenomeDataFrame class for featureData
bump version to 1.13.7
Add doRUnit.R
Add celfile-utils.Rd
Streamlne some of the Rd files
add validCEL function that checks whether all celfiles can be read
getFeatureData returns GenomeAnnotatedDataFrame
Remove imports from methods. Remove pdf of illumina_copynumber.pdf (large file) and copynumber.pdf
getFeatureDAta returns GenomeAnnotatedDataFrame
Remove separate vignette for copy number in inst/scripts. Include copynumber section in both affy and illumina pipelines.
update documentation files for genotype.Illumina, preprocessInf, and genotypeInf (cdfName added as argument. Indicate that 'batch' should be a character string)
pass cdfName to genotypeInf and preprocessInf
add unitTests and cn-functions for 'simple usage'
Combine AffyPreprocess and copynumber. Combine IlluminaPreprocess and copynumber
remove depency on ff to allow installation on my mac

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@62108 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 17/01/2012 19:13:44
Showing1 changed files
... ...
@@ -216,3 +216,14 @@ setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatr
216 216
 getBAF <- function(theta, canonicalTheta)
217 217
     .Call('normalizeBAF', theta, ct)
218 218
 
219
+
220
+validCEL <- function(celfiles){
221
+	for(i in seq_along(celfiles)){
222
+		res <- tryCatch(read.celfile(celfiles[i], intensity.means.only=TRUE), error=function(e) NULL)
223
+		if(is.null(res)) {
224
+			msg <- message("Problem reading ", celfiles[i])
225
+			stop(msg)
226
+		}
227
+	}
228
+	return("Successfully read all cel files")
229
+}
Browse code

adding normalizeBAF

Adding normalizeBAF(theta, canonicalTheta), implemented in C.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@58753 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 04/10/2011 16:11:12
Showing1 changed files
... ...
@@ -216,4 +216,3 @@ setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatr
216 216
 getBAF <- function(theta, canonicalTheta)
217 217
     .Call('normalizeBAF', theta, ct)
218 218
 
219
-
Browse code

crlmm on github

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@58751 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 04/10/2011 16:11:02
Showing1 changed files
... ...
@@ -215,3 +215,5 @@ setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatr
215 215
 ## Document this...
216 216
 getBAF <- function(theta, canonicalTheta)
217 217
     .Call('normalizeBAF', theta, ct)
218
+
219
+
Browse code

bringing changes from GitHub; from now on, keeping code on BioC servers

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@58710 bc3139a8-67e5-0310-9ffc-ced21a209358

Benilton Carvalho authored on 03/10/2011 18:12:55
Showing1 changed files
... ...
@@ -211,3 +211,7 @@ loadObject <- function(filename, load.it){
211 211
 
212 212
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
213 213
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
214
+
215
+## Document this...
216
+getBAF <- function(theta, canonicalTheta)
217
+    .Call('normalizeBAF', theta, ct)
Browse code

Added 'humancytosnp12v2p1h' as a new chip type for Illumina arrays

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@57404 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 12/08/2011 06:42:13
Showing1 changed files
... ...
@@ -165,7 +165,8 @@ validCdfNames <- function(){
165 165
 	  "humanomni1quadv1b",
166 166
           "humanomniexpress12v1b",
167 167
 	  "humanomni25quadv1b",
168
-          "humanimmuno12v1b")
168
+          "humanimmuno12v1b",
169
+          "humancytosnp12v2p1h")
169 170
 }
170 171
 isValidCdfName <- function(cdfName){
171 172
 	chipList <- validCdfNames()
Browse code

Check batch early in genotype function. Add genotypeRS function to genotype Illumina data. Fix stop message in getVarInEnv -- do not try to print envir.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@53853 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 18/03/2011 01:57:30
Showing1 changed files
... ...
@@ -33,7 +33,7 @@ isLoaded <- function(dataset, environ=.crlmmPkgEnv)
33 33
 
34 34
 getVarInEnv <- function(dataset, environ=.crlmmPkgEnv){
35 35
 	if (!isLoaded(dataset, environ=environ))
36
-		stop("Variable ", dataset, " not found in ", environ)
36
+		stop("Variable ", dataset, " not found in supplied environment")
37 37
 	environ[[dataset]]
38 38
 }
39 39
 
Browse code

commit after bioc rebase

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@52859 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 16/02/2011 16:19:11
Showing1 changed files
... ...
@@ -32,8 +32,8 @@ isLoaded <- function(dataset, environ=.crlmmPkgEnv)
32 32
 	exists(dataset, envir=environ)
33 33
 
34 34
 getVarInEnv <- function(dataset, environ=.crlmmPkgEnv){
35
-	if (!isLoaded(dataset))
36
-		stop("Variable ", dataset, " not found in .crlmmPkgEnv")
35
+	if (!isLoaded(dataset, environ=environ))
36
+		stop("Variable ", dataset, " not found in ", environ)
37 37
 	environ[[dataset]]
38 38
 }
39 39
 
... ...
@@ -168,12 +168,19 @@ validCdfNames <- function(){
168 168
           "humanimmuno12v1b")
169 169
 }
170 170
 isValidCdfName <- function(cdfName){
171
-    stopifnot(is.character(cdfName))
172
-    result <- cdfName %in% validCdfNames()
173
-    if (!result)
174
-        warning("cdfName must be one of the following: ",
175
-                chipList)
176
-    return(result)
171
+	chipList <- validCdfNames()
172
+	result <- cdfName %in% chipList
173
+	if(!(result)){
174
+		warning("cdfName must be one of the following: ",
175
+			chipList)
176
+	}
177
+	return(result)
178
+}
179
+
180
+isPackageLoaded <- function(pkg){
181
+	stopifnot(is.character(pkg))
182
+	pkg <- paste("package:", pkg, sep="")
183
+	pkg %in% search()
177 184
 }
178 185
 
179 186
 paramNames <- function(){
Browse code

Cleaning up... importing isPackageLoaded() from oligoClasses

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@51994 bc3139a8-67e5-0310-9ffc-ced21a209358

Benilton Carvalho authored on 20/01/2011 18:33:39
Showing1 changed files
... ...
@@ -94,9 +94,6 @@ list2SnpSet <- function(x, returnParams=FALSE){
94 94
                           "Center AA", "Center AB", "Center BB",
95 95
                           "Scale AA", "Scale AB", "Scale BB",
96 96
                           "N AA", "N AB", "N BB"),
97
-#                          "Shift in parameters AA",
98
-#                          "Shift in parameters AB",
99
-#                          "Shift in parameters BB"),
100 97
                         row.names=c(
101 98
                           "SNPQC",
102 99
                           "cAA", "cAB", "cBB",
... ...
@@ -142,8 +139,7 @@ loader <- function(theFile, envir, pkgname){
142 139
 
143 140
 celDates <- function(celfiles){
144 141
 	if(!all(file.exists(celfiles))) stop("1 or more cel file does not exist")
145
-	celdates <- vector("character", length(celfiles))
146
-	celtimes <- vector("character", length(celfiles))
142
+	celdates <- celtimes <- vector("character", length(celfiles))
147 143
 	for(i in seq(along=celfiles)){
148 144
 		if(i %% 100 == 0) cat(".")
149 145
 		tmp <- read.celfile.header(celfiles[i], info="full")$DatHeader
... ...
@@ -172,19 +168,12 @@ validCdfNames <- function(){
172 168
           "humanimmuno12v1b")
173 169
 }
174 170
 isValidCdfName <- function(cdfName){
175
-	chipList <- validCdfNames()
176
-	result <- cdfName %in% chipList	
177
-	if(!(result)){
178
-		warning("cdfName must be one of the following: ",
179
-			chipList)
180
-	}
181
-	return(result)
182
-}
183
-
184
-isPackageLoaded <- function(pkg){
185
-	stopifnot(is.character(pkg))
186
-	pkg <- paste("package:", pkg, sep="")
187
-	pkg %in% search()
171
+    stopifnot(is.character(cdfName))
172
+    result <- cdfName %in% validCdfNames()
173
+    if (!result)
174
+        warning("cdfName must be one of the following: ",
175
+                chipList)
176
+    return(result)
188 177
 }
189 178
 
190 179
 paramNames <- function(){
Browse code

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@50264 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 16/10/2010 13:23:54
Showing1 changed files
... ...
@@ -168,6 +168,7 @@ validCdfNames <- function(){
168 168
 	  "human1mduov3b",
169 169
 	  "humanomni1quadv1b",
170 170
           "humanomniexpress12v1b",
171
+	  "humanomni25quadv1b",
171 172
           "humanimmuno12v1b")
172 173
 }
173 174
 isValidCdfName <- function(cdfName){
Browse code

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@49420 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 16/09/2010 12:01:16
Showing1 changed files
... ...
@@ -167,7 +167,8 @@ validCdfNames <- function(){
167 167
 	  "human660quadv1a",
168 168
 	  "human1mduov3b",
169 169
 	  "humanomni1quadv1b",
170
-          "humanomniexpress12v1b")
170
+          "humanomniexpress12v1b",
171
+          "humanimmuno12v1b")
171 172
 }
172 173
 isValidCdfName <- function(cdfName){
173 174
 	chipList <- validCdfNames()
Browse code

Added methods for LinearModelParameter class. removed methods for SnpSuperSet class.

Added a lot of generics for accessing and updating elements in the
LinearModelParameter class.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@48949 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 21/08/2010 02:48:57
Showing1 changed files
... ...
@@ -208,21 +208,7 @@ loadObject <- function(filename, load.it){
208 208
 	} else return(FALSE)
209 209
 }
210 210
 
211
-initializeParamObject <- function(dimnames){
212
-	nr <- length(dimnames[[1]])
213
-	nc <- length(dimnames[[2]])
214
-	name <- paramNames()
215
-	ll <- vector("list", length(name))
216
-	if(isPackageLoaded("ff")){
217
-		for(i in seq(along=ll)) ll[[i]] <- createFF(name=name[i], dim=c(nr, nc), vmode="double")            ##ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
218
-		names(ll) <- name
219
-		ll <- do.call(ffdf, ll)
220
-	} else {
221
-		for(i in seq(along=ll)) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
222
-		names(ll) <- name
223
-	}
224
-	return(ll)
225
-}
211
+
226 212
 
227 213
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
228 214
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
Browse code

Fixed bug in fit.lm functions -- the correlations were assigned incorrectly.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@48923 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 21/08/2010 02:47:23
Showing1 changed files
... ...
@@ -29,11 +29,12 @@ intMedianSummaries <- function(mat, grps)
29 29
 ## R CMD check
30 30
 
31 31
 isLoaded <- function(dataset, environ=.crlmmPkgEnv)
32
-  exists(dataset, envir=environ)
32
+	exists(dataset, envir=environ)
33
+
33 34
 getVarInEnv <- function(dataset, environ=.crlmmPkgEnv){
34
-  if (!isLoaded(dataset))
35
-    stop("Variable ", dataset, " not found in .crlmmPkgEnv")
36
-  environ[[dataset]]
35
+	if (!isLoaded(dataset))
36
+		stop("Variable ", dataset, " not found in .crlmmPkgEnv")
37
+	environ[[dataset]]
37 38
 }
38 39
 
39 40
 list2SnpSet <- function(x, returnParams=FALSE){
Browse code

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@48480 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 28/07/2010 02:03:14
Showing1 changed files
... ...
@@ -165,7 +165,8 @@ validCdfNames <- function(){
165 165
 	  "human610quadv1b",
166 166
 	  "human660quadv1a",
167 167
 	  "human1mduov3b",
168
-	  "humanomni1quadv1b")
168
+	  "humanomni1quadv1b",
169
+          "humanomniexpress12v1b")
169 170
 }
170 171
 isValidCdfName <- function(cdfName){
171 172
 	chipList <- validCdfNames()
Browse code

added genotype2 and crlmmCopynumber2

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45672 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 02/04/2010 03:03:19
Showing1 changed files
... ...
@@ -184,23 +184,40 @@ isPackageLoaded <- function(pkg){
184 184
 }
185 185
 
186 186
 paramNames <- function(){
187
-	c("tau2A", "tau2B", "sig2A", "sig2B",
188
-	  "nuA", "nuA.se", "nuB",  "nuB.se", "phiA", "phiB", "phiAX", "phiBX",
189
-	  "phiA.se", "phiB.se", "corr", "corrA.BB", "corrB.AA")
187
+	c("tau2A",
188
+	  "tau2B", "sig2A", "sig2B",
189
+	  "nuA", ##"nuA.se",
190
+	  "nuB",  ##"nuB.se",
191
+	  "phiA",
192
+	  "phiB",
193
+	  "phiPrimeA",
194
+	  "phiPrimeB",
195
+	  ##"phiA.se", "phiB.se",
196
+	  "corrAB",
197
+	  "corrBB",
198
+	  "corrAA")
199
+}
200
+
201
+loadObject <- function(filename, load.it){
202
+	fname <- paste(filename, ".rda", sep="")
203
+	if(load.it & file.exists(file.path(ldPath(), fname))){
204
+		message("load.it is TRUE, loading previously saved ff object")
205
+		return(TRUE)
206
+	} else return(FALSE)
190 207
 }
191 208
 
192 209
 initializeParamObject <- function(dimnames){
193 210
 	nr <- length(dimnames[[1]])
194
-	nc <- length(dimnames[[2]])		
195
-	ll <- vector("list", 17)
211
+	nc <- length(dimnames[[2]])
196 212
 	name <- paramNames()
213
+	ll <- vector("list", length(name))
197 214
 	if(isPackageLoaded("ff")){
198
-		for(i in 1:17) ll[[i]] <- createFF(name=name[i], dim=c(nr, nc), vmode="double")            ##ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
199
-		names(ll) <- paramNames()
215
+		for(i in seq(along=ll)) ll[[i]] <- createFF(name=name[i], dim=c(nr, nc), vmode="double")            ##ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
216
+		names(ll) <- name
200 217
 		ll <- do.call(ffdf, ll)
201 218
 	} else {
202
-		for(i in 1:17) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
203
-		names(ll) <- paramNames()
219
+		for(i in seq(along=ll)) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
220
+		names(ll) <- name
204 221
 	}
205 222
 	return(ll)
206 223
 }
Browse code

Fixes in docs and code reorganization

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45608 bc3139a8-67e5-0310-9ffc-ced21a209358

Benilton Carvalho authored on 31/03/2010 11:16:26
Showing1 changed files
... ...
@@ -205,78 +205,5 @@ initializeParamObject <- function(dimnames){
205 205
 	return(ll)
206 206
 }
207 207
 
208
-## BC: how about moving initializeBigMatrix to oligoClasses?
209
-initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
210
-	if(isPackageLoaded("ff")){
211
-		if(prod(nr, nc) > 2^31){
212
-			##Need multiple matrices
213
-			## -- use ffdf
214
-			## How many samples per ff object
215
-			S <- floor(2^31/nr - 1)
216
-			## How many ff objects
217
-			L <- ceiling(nc/S)
218
-			name <- paste(name, 1:L, sep="_")
219
-			resultsff <- vector("list", L)
220
-			##resultsB <- vector("list", L)			
221
-			for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
222
-				resultsff[[i]] <- createFF(name=name[i],
223
-							   dim=c(nr, S),
224
-							   vmode=vmode)
225
-			}
226
-			##the Lth element
227
-			leftOver <- nc - ((L-1)*S)
228
-			resultsff[[L]] <- createFF(name=name[L],
229
-						   dim=c(nr, leftOver),
230
-						   vmode=vmode)
231
-			resultsff[[L]][,] <- NA
232
-			results <- do.call(ffdf, resultsff)
233
-			rm(resultsff); gc()
234
-			##dimnames(resultsff) <- dns
235
-		} else {
236
-			results <- createFF(name=name,
237
-					    dim=c(nr, nc),
238
-					    vmode=vmode)
239
-			results[,] <- NA
240
-		}
241
-	}  else {
242
-          theNA <- switch(vmode,
243
-                          integer=NA_integer_,
244
-                          double=NA_real_,
245
-                          character=NA_character_,
246
-                          stop("Mode ", vmode, " not implemented for regular matrices"))
247
-          results <- matrix(theNA, nr, nc)
248
-        }
249
-	return(results)
250
-}
251
-
252
-initializeBigVector <- function(name, n, vmode="integer"){
253
-  if(isPackageLoaded("ff")){
254
-    results <- ff(vmode=vmode, length=n, pattern=file.path(ldPath(), basename(name)))
255
-  }  else {
256
-    theNA <- switch(vmode,
257
-                    integer=NA_integer_,
258
-                    double=NA_real_,
259
-                    character=NA_character_,
260
-                    stop("Mode ", vmode, " not implemented for regular matrices"))
261
-    results <- rep(theNA, n)
262
-  }
263
-  return(results)
264
-}
265
-
266
-
267 208
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
268 209
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
269
-
270
-
271
-##annotatedDataFrameFromFF <- function (object, byrow = FALSE, ...){
272
-##    dims <- dim(object)
273
-##    if (is.null(dims) || all(dims == 0)) 
274
-##        annotatedDataFrameFrom(NULL, byrow = byrow, ...)
275
-##    else {
276
-##        N <- if (byrow)  dims[1]       else dims[2]
277
-##        nms <- if (byrow) rownames(object)  else colnames(object)
278
-##        data <- data.frame(numeric(N), row.names = nms)[, FALSE]
279
-##        dimLabels <- if (byrow) c("featureNames", "featureColumns")  else c("sampleNames", "sampleColumns")
280
-##        new("AnnotatedDataFrame", data = data, dimLabels = dimLabels)
281
-##    }
282
-##}
Browse code

HPC for snprma/crlmm on Affy

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45498 bc3139a8-67e5-0310-9ffc-ced21a209358

Benilton Carvalho authored on 25/03/2010 13:14:54
Showing1 changed files
... ...
@@ -37,7 +37,7 @@ getVarInEnv <- function(dataset, environ=.crlmmPkgEnv){
37 37
 }
38 38
 
39 39
 list2SnpSet <- function(x, returnParams=FALSE){
40
-  pd <- data.frame(SNR=x[["SNR"]], gender=x[["gender"]],
40
+  pd <- data.frame(SNR=x[["SNR"]][], gender=x[["gender"]],
41 41
                    batchQC=rep(x[["batchQC"]], ncol(x[["calls"]])),
42 42
                    row.names=colnames(x[["calls"]]))
43 43
   pdv <- data.frame(labelDescription=c("Signal-to-noise Ratio",
... ...
@@ -205,7 +205,7 @@ initializeParamObject <- function(dimnames){
205 205
 	return(ll)
206 206
 }
207 207
 
208
-
208
+## BC: how about moving initializeBigMatrix to oligoClasses?
209 209
 initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
210 210
 	if(isPackageLoaded("ff")){
211 211
 		if(prod(nr, nc) > 2^31){
... ...
@@ -238,9 +238,32 @@ initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
238 238
 					    vmode=vmode)
239 239
 			results[,] <- NA
240 240
 		}
241
-	}  else results <- matrix(NA, nr, nc)
241
+	}  else {
242
+          theNA <- switch(vmode,
243
+                          integer=NA_integer_,
244
+                          double=NA_real_,
245
+                          character=NA_character_,
246
+                          stop("Mode ", vmode, " not implemented for regular matrices"))
247
+          results <- matrix(theNA, nr, nc)
248
+        }
242 249
 	return(results)
243 250
 }
251
+
252
+initializeBigVector <- function(name, n, vmode="integer"){
253
+  if(isPackageLoaded("ff")){
254
+    results <- ff(vmode=vmode, length=n, pattern=file.path(ldPath(), basename(name)))
255
+  }  else {
256
+    theNA <- switch(vmode,
257
+                    integer=NA_integer_,
258
+                    double=NA_real_,
259
+                    character=NA_character_,
260
+                    stop("Mode ", vmode, " not implemented for regular matrices"))
261
+    results <- rep(theNA, n)
262
+  }
263
+  return(results)
264
+}
265
+
266
+
244 267
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
245 268
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
246 269
 
Browse code

updates to genotype, crlmmIlluminaRS, and crlmmCopynumber

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45497 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 25/03/2010 13:01:51
Showing1 changed files
... ...
@@ -195,7 +195,7 @@ initializeParamObject <- function(dimnames){
195 195
 	ll <- vector("list", 17)
196 196
 	name <- paramNames()
197 197
 	if(isPackageLoaded("ff")){
198
-		for(i in 1:17) ll[[i]] <- ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
198
+		for(i in 1:17) ll[[i]] <- createFF(name=name[i], dim=c(nr, nc), vmode="double")            ##ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
199 199
 		names(ll) <- paramNames()
200 200
 		ll <- do.call(ffdf, ll)
201 201
 	} else {
Browse code

updated genotype and crlmmIlluminaRS functions. suppressing integer overflow warnings that do not appear to be relevant

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45348 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 19/03/2010 16:00:25
Showing1 changed files
... ...
@@ -236,6 +236,7 @@ initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
236 236
 			results <- createFF(name=name,
237 237
 					    dim=c(nr, nc),
238 238
 					    vmode=vmode)
239
+			results[,] <- NA
239 240
 		}
240 241
 	}  else results <- matrix(NA, nr, nc)
241 242
 	return(results)
Browse code

update initializeBigMatrix. methods for CNSetLM

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45324 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 18/03/2010 13:47:33
Showing1 changed files
... ...
@@ -211,36 +211,34 @@ initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
211 211
 		if(prod(nr, nc) > 2^31){
212 212
 			##Need multiple matrices
213 213
 			## -- use ffdf
214
-			
215 214
 			## How many samples per ff object
216 215
 			S <- floor(2^31/nr - 1)
217
-
218 216
 			## How many ff objects
219 217
 			L <- ceiling(nc/S)
220 218
 			name <- paste(name, 1:L, sep="_")
221
-
222
-			results <- vector("list", L)
219
+			resultsff <- vector("list", L)
223 220
 			##resultsB <- vector("list", L)			
224 221
 			for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
225
-				results[[i]] <- createFF(name=name[i],
226
-							 dim=c(nr, S),
227
-							 vmode=vmode)
222
+				resultsff[[i]] <- createFF(name=name[i],
223
+							   dim=c(nr, S),
224
+							   vmode=vmode)
228 225
 			}
229 226
 			##the Lth element
230 227
 			leftOver <- nc - ((L-1)*S)
231
-			results[[L]] <- createFF(name=name[L],
232
-						 dim=c(nr, leftOver),
233
-						 vmode=vmode)
234
-			resultsff <- do.call(ffdf, results)
228
+			resultsff[[L]] <- createFF(name=name[L],
229
+						   dim=c(nr, leftOver),
230
+						   vmode=vmode)
231
+			resultsff[[L]][,] <- NA
232
+			results <- do.call(ffdf, resultsff)
233
+			rm(resultsff); gc()
235 234
 			##dimnames(resultsff) <- dns
236 235
 		} else {
237
-			resultsff <- createFF(name=name,
238
-					      dim=c(nr, nc),
239
-					      vmode=vmode)
236
+			results <- createFF(name=name,
237
+					    dim=c(nr, nc),
238
+					    vmode=vmode)
240 239
 		}
241
-		resultsff[,] <- NA
242
-	}  else resultsff <- matrix(NA, nr, nc)
243
-	return(resultsff)
240
+	}  else results <- matrix(NA, nr, nc)
241
+	return(results)
244 242
 }
245 243
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
246 244
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
Browse code

testing crlmmIlluminaRS in cnrma-functions

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45221 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 15/03/2010 01:43:23
Showing1 changed files
... ...
@@ -183,6 +183,29 @@ isPackageLoaded <- function(pkg){
183 183
 	pkg %in% search()
184 184
 }
185 185
 
186
+paramNames <- function(){
187
+	c("tau2A", "tau2B", "sig2A", "sig2B",
188
+	  "nuA", "nuA.se", "nuB",  "nuB.se", "phiA", "phiB", "phiAX", "phiBX",
189
+	  "phiA.se", "phiB.se", "corr", "corrA.BB", "corrB.AA")
190
+}
191
+
192
+initializeParamObject <- function(dimnames){
193
+	nr <- length(dimnames[[1]])
194
+	nc <- length(dimnames[[2]])		
195
+	ll <- vector("list", 17)
196
+	name <- paramNames()
197
+	if(isPackageLoaded("ff")){
198
+		for(i in 1:17) ll[[i]] <- ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
199
+		names(ll) <- paramNames()
200
+		ll <- do.call(ffdf, ll)
201
+	} else {
202
+		for(i in 1:17) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
203
+		names(ll) <- paramNames()
204
+	}
205
+	return(ll)
206
+}
207
+
208
+
186 209
 initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
187 210
 	if(isPackageLoaded("ff")){
188 211
 		if(prod(nr, nc) > 2^31){
... ...
@@ -221,3 +244,17 @@ initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
221 244
 }
222 245
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
223 246
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
247
+
248
+
249
+##annotatedDataFrameFromFF <- function (object, byrow = FALSE, ...){
250
+##    dims <- dim(object)
251
+##    if (is.null(dims) || all(dims == 0)) 
252
+##        annotatedDataFrameFrom(NULL, byrow = byrow, ...)
253
+##    else {
254
+##        N <- if (byrow)  dims[1]       else dims[2]
255
+##        nms <- if (byrow) rownames(object)  else colnames(object)
256
+##        data <- data.frame(numeric(N), row.names = nms)[, FALSE]
257
+##        dimLabels <- if (byrow) c("featureNames", "featureColumns")  else c("sampleNames", "sampleColumns")
258
+##        new("AnnotatedDataFrame", data = data, dimLabels = dimLabels)
259
+##    }
260
+##}
Browse code

added genotype function to cnrma-functions. Added AllClasses.R file to set ff_matrix and ffdf classes

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45165 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 11/03/2010 11:02:23
Showing1 changed files
... ...
@@ -155,7 +155,69 @@ celDates <- function(celfiles){
155 155
 	return(celdts)
156 156
 }
157 157
 
158
+validCdfNames <- function(){
159
+	c("genomewidesnp6",
160
+	  "genomewidesnp5",
161
+	  "human370v1c",
162
+	  "human370quadv3c",
163
+	  "human550v3b",
164
+	  "human650v3a",
165
+	  "human610quadv1b",
166
+	  "human660quadv1a",
167
+	  "human1mduov3b",
168
+	  "humanomni1quadv1b")
169
+}
170
+isValidCdfName <- function(cdfName){
171
+	chipList <- validCdfNames()
172
+	result <- cdfName %in% chipList	
173
+	if(!(result)){
174
+		warning("cdfName must be one of the following: ",
175
+			chipList)
176
+	}
177
+	return(result)
178
+}
158 179
 
180
+isPackageLoaded <- function(pkg){
181
+	stopifnot(is.character(pkg))
182
+	pkg <- paste("package:", pkg, sep="")
183
+	pkg %in% search()
184
+}
159 185
 
186
+initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
187
+	if(isPackageLoaded("ff")){
188
+		if(prod(nr, nc) > 2^31){
189
+			##Need multiple matrices
190
+			## -- use ffdf
191
+			
192
+			## How many samples per ff object
193
+			S <- floor(2^31/nr - 1)
194
+
195
+			## How many ff objects
196
+			L <- ceiling(nc/S)
197
+			name <- paste(name, 1:L, sep="_")
198
+
199
+			results <- vector("list", L)
200
+			##resultsB <- vector("list", L)			
201
+			for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
202
+				results[[i]] <- createFF(name=name[i],
203
+							 dim=c(nr, S),
204
+							 vmode=vmode)
205
+			}
206
+			##the Lth element
207
+			leftOver <- nc - ((L-1)*S)
208
+			results[[L]] <- createFF(name=name[L],
209
+						 dim=c(nr, leftOver),
210
+						 vmode=vmode)
211
+			resultsff <- do.call(ffdf, results)
212
+			##dimnames(resultsff) <- dns
213
+		} else {
214
+			resultsff <- createFF(name=name,
215
+					      dim=c(nr, nc),
216
+					      vmode=vmode)
217
+		}
218
+		resultsff[,] <- NA
219
+	}  else resultsff <- matrix(NA, nr, nc)
220
+	return(resultsff)
221
+}
160 222
 setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
161 223
 setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
Browse code

added annotatedDataFrameFrom methods for ff_matrix and ffdf

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45129 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 10/03/2010 11:45:52
Showing1 changed files
... ...
@@ -157,4 +157,5 @@ celDates <- function(celfiles){
157 157
 
158 158
 
159 159
 
160
-
160
+setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
161
+setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)
Browse code

roll back to crlmm version 1.5.24

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45126 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 10/03/2010 01:27:04
Showing1 changed files
... ...
@@ -155,235 +155,6 @@ celDates <- function(celfiles){
155 155
 	return(celdts)
156 156
 }
157 157
 
158
-isPackageLoaded <- function(pkg){
159
-	stopifnot(is.character(pkg))
160
-	pkg <- paste("package:", pkg, sep="")
161
-	pkg %in% search()
162
-}
163
-
164
-validCdfNames <- function(){
165
-	c("genomewidesnp6",
166
-	  "genomewidesnp5",
167
-	  "human370v1c",
168
-	  "human370quadv3c",
169
-	  "human550v3b",
170
-	  "human650v3a",
171
-	  "human610quadv1b",
172
-	  "human660quadv1a",
173
-	  "human1mduov3b",
174
-	  "humanomni1quadv1b")
175
-}
176
-
177
-isValidCdfName <- function(cdfName){
178
-	chipList <- validCdfNames()
179
-	result <- cdfName %in% chipList	
180
-	if(!(result)){
181
-		warning("cdfName must be one of the following: ",
182
-			chipList)
183
-	}
184
-	return(result)
185
-}
186
-
187
-initializeBigMatrix <- function(dns, vmode="integer"){
188
-##initializeBigMatrix <- function(nr, nc, vmode="integer"){
189
-	nr <- length(dns[[1]])
190
-	nc <- length(dns[[2]])
191
-	if(isPackageLoaded("ff")){
192
-	if(prod(nr, nc) > 2^31){
193
-		##Need multiple matrices
194
-		## -- use ffdf
195
-			
196
-		## How many samples per ff object
197
-		S <- floor(2^31/nr - 1)
198
-
199
-		## How many ff objects
200
-		L <- ceiling(nc/S)
201
-
202
-		results <- vector("list", L)
203
-		##resultsB <- vector("list", L)			
204
-		for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
205
-			results[[i]] <- ff(dim=c(nr, S),
206
-					   vmode=vmode,
207
-					   finalizer="close",
208
-					   overwrite=TRUE)
209
-		}
210
-		##the Lth element
211
-		leftOver <- nc - ((L-1)*S)
212
-		results[[L]] <- ff(dim=c(nr, leftOver),
213
-				   vmode=vmode,
214
-				   finalizer="close",
215
-				   overwrite=TRUE)
216
-		resultsff <- do.call(ffdf, results)
217
-		##dimnames(resultsff) <- dns
218
-	} else {
219
-		resultsff <- ff(dim=c(nr, nc),
220
-				vmode=vmode,
221
-				finalizer="close",
222
-				overwrite=TRUE)
223
-##				dimnames=dns)
224
-	}
225
-	resultsff[,] <- NA
226
-}  else resultsff <- matrix(NA, nr, nc)
227
-	return(resultsff)
228
-}
229
-
230
-paramNames <- function(){
231
-	c("tau2A", "tau2B", "sig2A", "sig2B",
232
-	  "nuA", "nuB", "nuA.se", "nuB.se", "phiA", "phiB", "phiA2", "phiB2",
233
-	  "phiA.se", "phiB.se", "corr", "corrA.BB", "corrB.AA")
234
-}
235 158
 
236
-initializeParamObject <- function(dimnames){
237
-	nr <- length(dimnames[[1]])
238
-	nc <- length(dimnames[[2]])		
239
-	ll <- vector("list", 17)
240
-	if(isPackageLoaded("ff")){
241
-		for(i in 1:17) ll[[i]] <- ff(dim=c(nr,nc), vmode="double", finalizer="close", dimnames=dimnames, overwrite=TRUE)
242
-		names(ll) <- paramNames()
243
-		ll <- do.call(ffdf, ll)
244
-	} else {
245
-		for(i in 1:17) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
246
-		names(ll) <- paramNames()
247
-	}
248
-	return(ll)
249
-}
250 159
 
251
-whichPlatform <- function(cdfName){
252
-	index <- grep("genomewidesnp", cdfName)
253
-	if(length(index) > 0){
254
-		platform <- "Affymetrix"
255
-	} else{
256
-		index <- grep("human", cdfName)
257
-		platform <- "Illumina"
258
-	}
259
-	return(platform)
260
-}
261
-
262
-updateParams <- function(cnParams, object, row.index, batch){
263
-	labels.asis <- fvarLabels(object)[4:20]
264
-	B <- batch
265
-	batch <- paste("_", batch, sep="")
266
-	labels <- as.character(sapply(labels.asis, function(x, batch) strsplit(x, batch)[[1]][1], batch=batch))
267
-	labels <- gsub("X", "2", labels)
268
-	if(!isPackageLoaded("ff")){
269
-		##batch <- paste("_", strsplit(labels.asis[1], batch), sep="")
270
-		##labels <- gsub("_", "\\.", labels.asis)
271
-		##labels <- gsub(paste("\\.", batch, sep=""), "", labels)
272
-		j <- match(B, colnames(cnParams[[1]]))
273
-		for(i in seq(along=labels)){
274
-			ii <- match(labels[i], names(cnParams))
275
-			jj <- match(labels.asis[i], fvarLabels(object))
276
-			cnParams[[ii]][, j] <- fData(object)[, jj]
277
-		}
278
-	} else {
279
-		##labels <- as.character(sapply(labels.asis, function(x, batch) strsplit(x, batch)[[1]][1], batch=batch))		
280
-		##labels <- gsub("_", "\\.", labels.asis)
281
-		##labels <- gsub("X", "2", labels)		
282
-		col.index <- match(labels, colnames(cnParams))
283
-		cnParams[row.index, col.index] <- fData(object)[, 4:20]
284
-	}
285
-	return(cnParams)
286
-}
287 160
 
288
-##			tau2A[row.index, i] <- getParam(cnSet, "tau2A", unique(batch)[i])
289
-##			tau2B[row.index, i] <- getParam(cnSet, "tau2B", unique(batch)[i])
290
-##			sig2A[row.index, i] <- getParam(cnSet, "sig2A", unique(batch)[i])
291
-##			sig2B[row.index, i] <- getParam(cnSet, "sig2B", unique(batch)[i])
292
-##			nuA[row.index, i] <- getParam(cnSet, "nuA", unique(batch)[i])
293
-##			nuA.se[row.index, i] <- getParam(cnSet, "nuA.se", unique(batch)[i])					
294
-##			nuB[row.index, i] <- getParam(cnSet, "nuB", unique(batch)[i])
295
-##			nuB.se[row.index, i] <- getParam(cnSet, "nuB.se", unique(batch)[i])										
296
-##			phiA[row.index, i] <- getParam(cnSet, "phiA", unique(batch)[i])
297
-##			phiA.se[row.index, i] <- getParam(cnSet, "phiA.se", unique(batch)[i])																				
298
-##			phiB[row.index, i] <- getParam(cnSet, "phiB", unique(batch)[i])
299
-##			phiB.se[row.index, i] <- getParam(cnSet, "phiB.se", unique(batch)[i])															
300
-##			corr[row.index, i] <- getParam(cnSet, "corr", unique(batch)[i])
301
-##			corrA.BB[row.index, i] <- getParam(cnSet, "corrA.BB", unique(batch)[i])
302
-##			corrB.AA[row.index, i] <- getParam(cnSet, "corrB.AA", unique(batch)[i])
303
-##			if(CHR==23){
304
-##				phiA2[row.index, i] <- getParam(cnSet, "phiA2", unique(batch)[i])
305
-##				phiB2[row.index, i] <- getParam(cnSet, "phiB2", unique(batch)[i])
306
-##			}
307
-##			if(!isPackageLoaded("ff")){
308
-##				save(cnSet, file=paste(cnFile, "_", PLATE, "_", CHR, ".rda", sep=""))				
309
-##				cnParams <- list(tau2A=tau2A,
310
-##						 tau2B=tau2B,
311
-##						 sig2A=sig2A,
312
-##						 sig2B=sig2B,
313
-##						 nuA=nuA,
314
-##						 nuB=nuB,
315
-##						 nuA.se=nuA.se,
316
-##						 nuB.se=nuB.se,
317
-##						 phiA=phiA,
318
-##						 phiA2=phiA2,
319
-##						 phiB=phiB,
320
-##						 phiB2=phiB2,
321
-##						 phiA.se=phiA.se,
322
-##						 phiB.se=phiB.se,
323
-##						 corr=corr,
324
-##						 corrA.BB=corrA.BB,
325
-##						 corrB.AA=corrB.AA)
326
-##				save(cnParams, file=paste(outfile, "cnParams_", PLATE, "_", CHR, ".rda", sep=""))
327
-##			}
328
-
329
-##parameterMatrix <- function(object){
330
-##	CHR <- unique(chromosome(object))
331
-##	tau2A[row.index, i] <- getParam(cnSet, "tau2A", unique(batch)[i])
332
-##	tau2B[row.index, i] <- getParam(cnSet, "tau2B", unique(batch)[i])
333
-##	sig2A[row.index, i] <- getParam(cnSet, "sig2A", unique(batch)[i])
334
-##	sig2B[row.index, i] <- getParam(cnSet, "sig2B", unique(batch)[i])
335
-##	nuA[row.index, i] <- getParam(cnSet, "nuA", unique(batch)[i])
336
-##	nuA.se[row.index, i] <- getParam(cnSet, "nuA.se", unique(batch)[i])					
337
-##	nuB[row.index, i] <- getParam(cnSet, "nuB", unique(batch)[i])
338
-##	nuB.se[row.index, i] <- getParam(cnSet, "nuB.se", unique(batch)[i])										
339
-##	phiA[row.index, i] <- getParam(cnSet, "phiA", unique(batch)[i])
340
-##	phiA.se[row.index, i] <- getParam(cnSet, "phiA.se", unique(batch)[i])																				
341
-##	phiB[row.index, i] <- getParam(cnSet, "phiB", unique(batch)[i])
342
-##	phiB.se[row.index, i] <- getParam(cnSet, "phiB.se", unique(batch)[i])															
343
-##	corr[row.index, i] <- getParam(cnSet, "corr", unique(batch)[i])
344
-##	corrA.BB[row.index, i] <- getParam(cnSet, "corrA.BB", unique(batch)[i])
345
-##	corrB.AA[row.index, i] <- getParam(cnSet, "corrB.AA", unique(batch)[i])
346
-##	CA[row.index, sample.index] <- cnSet@assayData[["CA"]]
347
-##	CB[row.index, sample.index] <- cnSet@assayData[["CB"]]
348
-##	if(CHR==23){
349
-##		phiA2[row.index, i] <- getParam(cnSet, "phiA2", unique(batch)[i])
350
-##		phiB2[row.index, i] <- getParam(cnSet, "phiB2", unique(batch)[i])
351
-##	}
352
-##	paramFF <- ffdf(tau2A=tau2A,
353
-##			tau2B=tau2B,
354
-##			sig2A=sig2A,
355
-##			sig2B=sig2B,
356
-##			nuA=nuA,
357
-##			nuB=nuB,
358
-##			nuA.se=nuA.se,
359
-##			nuB.se=nuB.se,
360
-##			phiA=phiA,
361
-##			phiA2=phiA2,
362
-##			phiB=phiB,
363
-##			phiB2=phiB2,
364
-##			phiA.se=phiA.se,
365
-##			phiB.se=phiB.se,
366
-##			corr=corr,
367
-##			corrA.BB=corrA.BB,
368
-##			corrB.AA=corrB.AA)
369
-##	return(paramFF)
370
-##}
371
-
372
-constructClass <- function(annotation){
373
-	thisclass <- whichClass(annotation)
374
-	obj <- new(thisclass, annotation=annotation)
375
-	crlmmOptions(obj) <- getOptions(obj)
376
-	obj
377
-}
378
-
379
-whichClass <- function(cdfName){
380
-	stopifnot(isValidCdfName(cdfName))
381
-	platform <- whichPlatform(cdfName)
382
-	if(isPackageLoaded("ff")){
383
-		thisclass <- paste(platform, "AlleleSet", sep="")
384
-	} else {
385
-		thisclass <- paste(platform, "AlleleSet", sep="")
386
-	}
387
-	return(thisclass)
388
-}
389
-setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45084 bc3139a8-67e5-0310-9ffc-ced21a209358

unknown authored on 08/03/2010 07:07:43
Showing1 changed files
... ...
@@ -170,7 +170,8 @@ validCdfNames <- function(){
170 170
 	  "human650v3a",
171 171
 	  "human610quadv1b",
172 172
 	  "human660quadv1a",
173
-	  "human1mduov3b")
173
+	  "human1mduov3b",
174
+	  "humanomni1quadv1b")
174 175
 }
175 176
 
176 177
 isValidCdfName <- function(cdfName){
Browse code

several updates for ff. new classes for affy/illumina processing. More s4-style code

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@45083 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 08/03/2010 04:46:55
Showing1 changed files
... ...
@@ -183,7 +183,11 @@ isValidCdfName <- function(cdfName){
183 183
 	return(result)
184 184
 }
185 185
 
186
-initializeBigMatrix <- function(nr, nc, batch, vmode="integer"){
186
+initializeBigMatrix <- function(dns, vmode="integer"){
187
+##initializeBigMatrix <- function(nr, nc, vmode="integer"){
188
+	nr <- length(dns[[1]])
189
+	nc <- length(dns[[2]])
190
+	if(isPackageLoaded("ff")){
187 191
 	if(prod(nr, nc) > 2^31){
188 192
 		##Need multiple matrices
189 193
 		## -- use ffdf
... ...
@@ -209,13 +213,176 @@ initializeBigMatrix <- function(nr, nc, batch, vmode="integer"){
209 213
 				   finalizer="close",
210 214
 				   overwrite=TRUE)
211 215
 		resultsff <- do.call(ffdf, results)
216
+		##dimnames(resultsff) <- dns
212 217
 	} else {
213 218
 		resultsff <- ff(dim=c(nr, nc),
214 219
 				vmode=vmode,
215 220
 				finalizer="close",
216 221
 				overwrite=TRUE)
222
+##				dimnames=dns)
217 223
 	}
224
+	resultsff[,] <- NA
225
+}  else resultsff <- matrix(NA, nr, nc)
218 226
 	return(resultsff)
219 227
 }
220 228
 
229
+paramNames <- function(){
230
+	c("tau2A", "tau2B", "sig2A", "sig2B",
231
+	  "nuA", "nuB", "nuA.se", "nuB.se", "phiA", "phiB", "phiA2", "phiB2",
232
+	  "phiA.se", "phiB.se", "corr", "corrA.BB", "corrB.AA")
233
+}
234
+
235
+initializeParamObject <- function(dimnames){
236
+	nr <- length(dimnames[[1]])
237
+	nc <- length(dimnames[[2]])		
238
+	ll <- vector("list", 17)
239
+	if(isPackageLoaded("ff")){
240
+		for(i in 1:17) ll[[i]] <- ff(dim=c(nr,nc), vmode="double", finalizer="close", dimnames=dimnames, overwrite=TRUE)
241
+		names(ll) <- paramNames()
242
+		ll <- do.call(ffdf, ll)
243
+	} else {
244
+		for(i in 1:17) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
245
+		names(ll) <- paramNames()
246
+	}
247
+	return(ll)
248
+}
249
+
250
+whichPlatform <- function(cdfName){
251
+	index <- grep("genomewidesnp", cdfName)
252
+	if(length(index) > 0){
253
+		platform <- "Affymetrix"
254
+	} else{
255
+		index <- grep("human", cdfName)
256
+		platform <- "Illumina"
257
+	}
258
+	return(platform)
259
+}
260
+
261
+updateParams <- function(cnParams, object, row.index, batch){
262
+	labels.asis <- fvarLabels(object)[4:20]
263
+	B <- batch
264
+	batch <- paste("_", batch, sep="")
265
+	labels <- as.character(sapply(labels.asis, function(x, batch) strsplit(x, batch)[[1]][1], batch=batch))
266
+	labels <- gsub("X", "2", labels)
267
+	if(!isPackageLoaded("ff")){
268
+		##batch <- paste("_", strsplit(labels.asis[1], batch), sep="")
269
+		##labels <- gsub("_", "\\.", labels.asis)
270
+		##labels <- gsub(paste("\\.", batch, sep=""), "", labels)
271
+		j <- match(B, colnames(cnParams[[1]]))
272
+		for(i in seq(along=labels)){
273
+			ii <- match(labels[i], names(cnParams))
274
+			jj <- match(labels.asis[i], fvarLabels(object))
275
+			cnParams[[ii]][, j] <- fData(object)[, jj]
276
+		}
277
+	} else {
278
+		##labels <- as.character(sapply(labels.asis, function(x, batch) strsplit(x, batch)[[1]][1], batch=batch))		
279
+		##labels <- gsub("_", "\\.", labels.asis)
280
+		##labels <- gsub("X", "2", labels)		
281
+		col.index <- match(labels, colnames(cnParams))
282
+		cnParams[row.index, col.index] <- fData(object)[, 4:20]
283
+	}
284
+	return(cnParams)
285
+}
286
+
287
+##			tau2A[row.index, i] <- getParam(cnSet, "tau2A", unique(batch)[i])
288
+##			tau2B[row.index, i] <- getParam(cnSet, "tau2B", unique(batch)[i])
289
+##			sig2A[row.index, i] <- getParam(cnSet, "sig2A", unique(batch)[i])
290
+##			sig2B[row.index, i] <- getParam(cnSet, "sig2B", unique(batch)[i])
291
+##			nuA[row.index, i] <- getParam(cnSet, "nuA", unique(batch)[i])
292
+##			nuA.se[row.index, i] <- getParam(cnSet, "nuA.se", unique(batch)[i])					
293
+##			nuB[row.index, i] <- getParam(cnSet, "nuB", unique(batch)[i])
294
+##			nuB.se[row.index, i] <- getParam(cnSet, "nuB.se", unique(batch)[i])										
295
+##			phiA[row.index, i] <- getParam(cnSet, "phiA", unique(batch)[i])
296
+##			phiA.se[row.index, i] <- getParam(cnSet, "phiA.se", unique(batch)[i])																				
297
+##			phiB[row.index, i] <- getParam(cnSet, "phiB", unique(batch)[i])
298
+##			phiB.se[row.index, i] <- getParam(cnSet, "phiB.se", unique(batch)[i])															
299
+##			corr[row.index, i] <- getParam(cnSet, "corr", unique(batch)[i])
300
+##			corrA.BB[row.index, i] <- getParam(cnSet, "corrA.BB", unique(batch)[i])
301
+##			corrB.AA[row.index, i] <- getParam(cnSet, "corrB.AA", unique(batch)[i])
302
+##			if(CHR==23){
303
+##				phiA2[row.index, i] <- getParam(cnSet, "phiA2", unique(batch)[i])
304
+##				phiB2[row.index, i] <- getParam(cnSet, "phiB2", unique(batch)[i])
305
+##			}
306
+##			if(!isPackageLoaded("ff")){
307
+##				save(cnSet, file=paste(cnFile, "_", PLATE, "_", CHR, ".rda", sep=""))				
308
+##				cnParams <- list(tau2A=tau2A,
309
+##						 tau2B=tau2B,
310
+##						 sig2A=sig2A,
311
+##						 sig2B=sig2B,
312
+##						 nuA=nuA,
313
+##						 nuB=nuB,
314
+##						 nuA.se=nuA.se,
315
+##						 nuB.se=nuB.se,
316
+##						 phiA=phiA,
317
+##						 phiA2=phiA2,
318
+##						 phiB=phiB,
319
+##						 phiB2=phiB2,
320
+##						 phiA.se=phiA.se,
321
+##						 phiB.se=phiB.se,
322
+##						 corr=corr,
323
+##						 corrA.BB=corrA.BB,
324
+##						 corrB.AA=corrB.AA)
325
+##				save(cnParams, file=paste(outfile, "cnParams_", PLATE, "_", CHR, ".rda", sep=""))
326
+##			}
327
+
328
+##parameterMatrix <- function(object){
329
+##	CHR <- unique(chromosome(object))
330
+##	tau2A[row.index, i] <- getParam(cnSet, "tau2A", unique(batch)[i])
331
+##	tau2B[row.index, i] <- getParam(cnSet, "tau2B", unique(batch)[i])
332
+##	sig2A[row.index, i] <- getParam(cnSet, "sig2A", unique(batch)[i])
333
+##	sig2B[row.index, i] <- getParam(cnSet, "sig2B", unique(batch)[i])
334
+##	nuA[row.index, i] <- getParam(cnSet, "nuA", unique(batch)[i])
335
+##	nuA.se[row.index, i] <- getParam(cnSet, "nuA.se", unique(batch)[i])					
336
+##	nuB[row.index, i] <- getParam(cnSet, "nuB", unique(batch)[i])
337
+##	nuB.se[row.index, i] <- getParam(cnSet, "nuB.se", unique(batch)[i])										
338
+##	phiA[row.index, i] <- getParam(cnSet, "phiA", unique(batch)[i])
339
+##	phiA.se[row.index, i] <- getParam(cnSet, "phiA.se", unique(batch)[i])																				
340
+##	phiB[row.index, i] <- getParam(cnSet, "phiB", unique(batch)[i])
341
+##	phiB.se[row.index, i] <- getParam(cnSet, "phiB.se", unique(batch)[i])															
342
+##	corr[row.index, i] <- getParam(cnSet, "corr", unique(batch)[i])
343
+##	corrA.BB[row.index, i] <- getParam(cnSet, "corrA.BB", unique(batch)[i])
344
+##	corrB.AA[row.index, i] <- getParam(cnSet, "corrB.AA", unique(batch)[i])
345
+##	CA[row.index, sample.index] <- cnSet@assayData[["CA"]]
346
+##	CB[row.index, sample.index] <- cnSet@assayData[["CB"]]
347
+##	if(CHR==23){
348
+##		phiA2[row.index, i] <- getParam(cnSet, "phiA2", unique(batch)[i])
349
+##		phiB2[row.index, i] <- getParam(cnSet, "phiB2", unique(batch)[i])
350
+##	}
351
+##	paramFF <- ffdf(tau2A=tau2A,
352
+##			tau2B=tau2B,
353
+##			sig2A=sig2A,
354
+##			sig2B=sig2B,
355
+##			nuA=nuA,
356
+##			nuB=nuB,
357
+##			nuA.se=nuA.se,
358
+##			nuB.se=nuB.se,
359
+##			phiA=phiA,
360
+##			phiA2=phiA2,
361
+##			phiB=phiB,
362
+##			phiB2=phiB2,
363
+##			phiA.se=phiA.se,
364
+##			phiB.se=phiB.se,
365
+##			corr=corr,
366
+##			corrA.BB=corrA.BB,
367
+##			corrB.AA=corrB.AA)
368
+##	return(paramFF)
369
+##}
221 370
 
371
+constructClass <- function(annotation){
372
+	thisclass <- whichClass(annotation)
373
+	obj <- new(thisclass, annotation=annotation)
374
+	crlmmOptions(obj) <- getOptions(obj)
375
+	obj
376
+}
377
+
378
+whichClass <- function(cdfName){
379
+	stopifnot(isValidCdfName(cdfName))
380
+	platform <- whichPlatform(cdfName)
381
+	if(isPackageLoaded("ff")){
382
+		thisclass <- paste(platform, "AlleleSet", sep="")
383
+	} else {
384
+		thisclass <- paste(platform, "AlleleSet", sep="")
385
+	}
386
+	return(thisclass)
387
+}
388
+setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
Browse code

more ff support

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@44783 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 22/02/2010 03:25:51
Showing1 changed files
... ...
@@ -183,4 +183,39 @@ isValidCdfName <- function(cdfName){
183 183
 	return(result)
184 184
 }
185 185
 
186
+initializeBigMatrix <- function(nr, nc, batch, vmode="integer"){
187
+	if(prod(nr, nc) > 2^31){
188
+		##Need multiple matrices
189
+		## -- use ffdf
190
+			
191
+		## How many samples per ff object
192
+		S <- floor(2^31/nr - 1)
193
+
194
+		## How many ff objects
195
+		L <- ceiling(nc/S)
196
+
197
+		results <- vector("list", L)
198
+		##resultsB <- vector("list", L)			
199
+		for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
200
+			results[[i]] <- ff(dim=c(nr, S),
201
+					   vmode=vmode,
202
+					   finalizer="close",
203
+					   overwrite=TRUE)
204
+		}
205
+		##the Lth element
206
+		leftOver <- nc - ((L-1)*S)
207
+		results[[L]] <- ff(dim=c(nr, leftOver),
208
+				   vmode=vmode,
209
+				   finalizer="close",
210
+				   overwrite=TRUE)
211
+		resultsff <- do.call(ffdf, results)
212
+	} else {
213
+		resultsff <- ff(dim=c(nr, nc),
214
+				vmode=vmode,
215
+				finalizer="close",
216
+				overwrite=TRUE)
217
+	}
218
+	return(resultsff)
219
+}
220
+
186 221
 
Browse code

begin adding support for ff. added an option to use poe

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@44778 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 20/02/2010 23:39:45
Showing1 changed files
... ...
@@ -155,6 +155,32 @@ celDates <- function(celfiles){
155 155
 	return(celdts)
156 156
 }
157 157
 
158
+isPackageLoaded <- function(pkg){
159
+	stopifnot(is.character(pkg))
160
+	pkg <- paste("package:", pkg, sep="")
161
+	pkg %in% search()
162
+}
163
+
164
+validCdfNames <- function(){
165
+	c("genomewidesnp6",
166
+	  "genomewidesnp5",
167
+	  "human370v1c",
168
+	  "human370quadv3c",
169
+	  "human550v3b",
170
+	  "human650v3a",
171
+	  "human610quadv1b",
172
+	  "human660quadv1a",
173
+	  "human1mduov3b")
174
+}
158 175
 
176
+isValidCdfName <- function(cdfName){
177
+	chipList <- validCdfNames()
178
+	result <- cdfName %in% chipList	
179
+	if(!(result)){
180
+		warning("cdfName must be one of the following: ",
181
+			chipList)
182
+	}
183
+	return(result)
184
+}
159 185
 
160 186
 
Browse code

updates to namespace, cnrma-functions

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@43541 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 14/12/2009 14:12:43
Showing1 changed files
... ...
@@ -20,10 +20,7 @@ medianSummaries <- function(mat, grps)
20 20
 intMedianSummaries <- function(mat, grps)
21 21
   as.integer(medianSummaries(mat, grps))
22 22
 
23
-list.celfiles <-   function(...){
24
-  files <- list.files(...)
25
-  return(files[grep("\\.[cC][eE][lL]$", files)])
26
-}
23
+
27 24
 
28 25
 ## .crlmmPkgEnv is an enviroment that will
29 26
 ## store all the variables used by the pkg.
... ...
@@ -142,19 +139,22 @@ loader <- function(theFile, envir, pkgname){
142 139
 	load(theFile, envir=envir)
143 140
 }
144 141
 
145
-celfileDate <- function(filename) {
146
-	h <- affyio::read.celfile.header(filename, info="full")
147
-	date <- grep("/", strsplit(h$DatHeader, " ")[[1]], value=TRUE)
148
-	if(length(date) < 1){
149
-		##try something else
150
-		results <- h$ScanDate
151
-	} else{
152
-		date <- strsplit(date, split="/")[[1]]
153
-		CC <- ifelse(substr(date[3],1,1)=="9", "19", "20")
154
-		results <- as.character(as.Date(paste(paste(CC, date[3], sep=""), date[1],
155
-						      date[2], sep="-")))
142
+celDates <- function(celfiles){
143
+	if(!all(file.exists(celfiles))) stop("1 or more cel file does not exist")
144
+	celdates <- vector("character", length(celfiles))
145
+	celtimes <- vector("character", length(celfiles))
146
+	for(i in seq(along=celfiles)){
147
+		if(i %% 100 == 0) cat(".")
148
+		tmp <- read.celfile.header(celfiles[i], info="full")$DatHeader
149
+		tmp <- strsplit(tmp, "\ +")
150
+		celdates[i] <- tmp[[1]][6]
151
+		celtimes[i] <- tmp[[1]][7]
156 152
 	}
157
-	results
153
+	tmp <- paste(celdates, celtimes)
154
+	celdts <- strptime(tmp, "%m/%d/%y %H:%M:%S")
155
+	return(celdts)
158 156
 }
159 157
 
160 158
 
159
+
160
+
Browse code

updates for compatability with oligoClasses

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@43365 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 03/12/2009 13:02:58
Showing1 changed files
... ...
@@ -135,11 +135,11 @@ list2SnpSet <- function(x, returnParams=FALSE){
135 135
 }
136 136
 
137 137
 loader <- function(theFile, envir, pkgname){
138
-  theFile <- file.path(system.file(package=pkgname),
139
-                       "extdata", theFile)
140
-  if (!file.exists(theFile))
141
-    stop("File ", theFile, " does not exist in ", pkgname)
142
-  load(theFile, envir=envir)
138
+	theFile <- file.path(system.file(package=pkgname),
139
+			     "extdata", theFile)
140
+	if (!file.exists(theFile))
141
+		stop("File ", theFile, " does not exist in ", pkgname)
142
+	load(theFile, envir=envir)
143 143
 }
144 144
 
145 145
 celfileDate <- function(filename) {
Browse code

numerous changes to the code and class definitions used for copy number estimation

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@43010 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 15/11/2009 10:46:23
Showing1 changed files
... ...
@@ -142,4 +142,19 @@ loader <- function(theFile, envir, pkgname){
142 142
   load(theFile, envir=envir)
143 143
 }
144 144
 
145
+celfileDate <- function(filename) {
146
+	h <- affyio::read.celfile.header(filename, info="full")
147
+	date <- grep("/", strsplit(h$DatHeader, " ")[[1]], value=TRUE)
148
+	if(length(date) < 1){
149
+		##try something else
150
+		results <- h$ScanDate
151
+	} else{
152
+		date <- strsplit(date, split="/")[[1]]
153
+		CC <- ifelse(substr(date[3],1,1)=="9", "19", "20")
154
+		results <- as.character(as.Date(paste(paste(CC, date[3], sep=""), date[1],
155
+						      date[2], sep="-")))
156
+	}
157
+	results
158
+}
159
+
145 160
 
Browse code

Removed unneeded C-code and cleaned some crlmm functions

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@42999 bc3139a8-67e5-0310-9ffc-ced21a209358

Benilton Carvalho authored on 14/11/2009 17:26:14
Showing1 changed files
... ...
@@ -11,22 +11,18 @@ changeToCrlmmAnnotationName <- function(x){
11 11
 }
12 12
 
13 13
 getCrlmmAnnotationName <- function(x){
14
-	paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
14
+  paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
15 15
 }
16 16
 
17 17
 medianSummaries <- function(mat, grps)
18 18
   .Call("R_subColSummarize_median", mat, grps, PACKAGE = "preprocessCore")
19 19
 
20 20
 intMedianSummaries <- function(mat, grps)
21
-	as.integer(medianSummaries(mat, grps))
22
-
23
-testProb <- function(p)
24
-  .Call("test", p)
25
-
21
+  as.integer(medianSummaries(mat, grps))
26 22
 
27 23
 list.celfiles <-   function(...){
28
-	files <- list.files(...)
29
-	return(files[grep("\\.[cC][eE][lL]$", files)])