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
Showing15 changed files

... ...
@@ -10,7 +10,7 @@ License: Artistic-2.0
10 10
 Depends: R (>= 2.11.0),
11 11
          methods,
12 12
          Biobase (>= 2.7.2),
13
-         oligoClasses (>= 1.9.50)
13
+         oligoClasses (>= 1.11.0)
14 14
 Imports: affyio (>= 1.15.2),
15 15
          ellipse,
16 16
          ff,
... ...
@@ -29,6 +29,7 @@ Collate: AllGenerics.R
29 29
 	 AllClasses.R
30 30
 	 methods-CNSet.R
31 31
 	 methods-eSet.R
32
+	 methods-LinearModelParameter.R
32 33
          methods-SnpSuperSet.R
33 34
          cnrma-functions.R
34 35
          crlmm-functions.R
... ...
@@ -29,7 +29,7 @@ importClassesFrom(oligoClasses, SnpSuperSet, AlleleSet, CNSet)
29 29
 importMethodsFrom(oligoClasses, allele, calls, "calls<-", confs,
30 30
 		  "confs<-", cnConfidence, "cnConfidence<-", isSnp,
31 31
 		  chromosome, position, A, B,
32
-		  "A<-", "B<-", open, close)
32
+		  "A<-", "B<-", open, close, lM, "lM<-")
33 33
 
34 34
 importFrom(oligoClasses, chromosome2integer, celfileDate, list.celfiles,
35 35
            copyNumber, initializeBigMatrix, initializeBigVector)
... ...
@@ -55,15 +55,13 @@ importFrom(ellipse, ellipse)
55 55
 
56 56
 importFrom(ff, ffdf, physical.ff, physical.ffdf)
57 57
 
58
-exportClasses(CNSetLM, ffdf, list)
59
-exportMethods(open, "[", show, lM, lines, nu, phi, corr, sigma2, tau2)
60
-exportMethods(CA, CB, totalCopyNumber)
58
+exportClasses(ffdf, list)
59
+exportMethods(lines)
60
+exportMethods(CA, CB, totalCopyNumber, initialize)
61 61
 export(crlmm, 
62
-##       crlmmCopynumber, 
63 62
        crlmmIllumina, 
64 63
        crlmmIllumina2,
65 64
        ellipseCenters,
66
-##       genotype, 
67 65
        readIdatFiles, 
68 66
        readIdatFiles2,
69 67
        snprma,
... ...
@@ -73,12 +71,13 @@ export(crlmm,
73 71
        batch,
74 72
        crlmmCopynumber2, crlmmCopynumberLD)
75 73
 export(constructIlluminaCNSet)
76
-export(linesCNSetLM)
74
+##export(linesCNSet)
77 75
 export(computeCN, fit.lm1, fit.lm2, fit.lm3, fit.lm4, construct,
78 76
        dqrlsWrapper, fit.wls)
79 77
 export(computeCopynumber, ACN)
80 78
 
81
-
79
+## For debugging
80
+exportPattern("^[^\\.]")
82 81
 
83 82
 
84 83
 
... ...
@@ -1,26 +1,8 @@
1
-setOldClass("ffdf")
1
+setOldClass("ellipse")
2 2
 setOldClass("ff_matrix")
3
-##setClassUnion("matrix_or_ff", c("matrix", "ff_matrix"))
4
-setClassUnion("list_or_ffdf", c("list", "ffdf"))
3
+setOldClass("ffdf")
5 4
 setClassUnion("ff_or_matrix", c("ff_matrix", "matrix", "ffdf"))
6
-setClass("CNSetLM", contains="CNSet", representation(lM="list_or_ffdf"))
7
-setMethod("initialize", "CNSetLM", function(.Object, lM=new("list"), ...){
8
-	.Object@lM <- lM
9
-	.Object <- callNextMethod(.Object, ...)
10
-})
11
-
12
-setValidity("CNSetLM",
13
-	    function(object){
14
-		    if(!"batch" %in% varLabels(protocolData(object)))
15
-			    return("'batch' not defined in protocolData")
16
-		    if(!"chromosome" %in% fvarLabels(object))
17
-			    return("'chromosome' not defined in featureData")
18
-		    if(!"position" %in% fvarLabels(object))
19
-			    return("'position' not defined in featureData")
20
-		    if(!"isSnp" %in% fvarLabels(object))
21
-			    return("'isSnp' not defined in featureData")
22
-		    return(TRUE)
23
-	    })
24
-
5
+setClassUnion("integerOrMissing", c("integer", "missing", "numeric"))
6
+##setClass("CNSetLM", contains="CNSet", representation(lM="list_or_ffdf"))
25 7
 ##setClass("CNSetTest", contains="SnpSuperSet")
26 8
 
... ...
@@ -1,23 +1,49 @@
1
-setGeneric("batch", function(object) standardGeneric("batch"))
2
-setGeneric("getParam", function(object, name, batch) standardGeneric("getParam"))
1
+##setGeneric("batch", function(object) standardGeneric("batch"))
2
+##setGeneric("getParam", function(object, name, batch) standardGeneric("getParam"))
3 3
 setGeneric("cnIndex", function(object) standardGeneric("cnIndex"))
4 4
 setGeneric("cnNames", function(object) standardGeneric("cnNames"))
5 5
 setGeneric("computeCopynumber", function(object, ...) standardGeneric("computeCopynumber"))
6
-setGeneric("pr", function(object, name, batch, value) standardGeneric("pr"))
6
+##setGeneric("pr", function(object, name, batch, value) standardGeneric("pr"))
7 7
 setGeneric("snpIndex", function(object) standardGeneric("snpIndex"))
8 8
 setGeneric("snpNames", function(object) standardGeneric("snpNames"))
9
-setGeneric("lM", function(object) standardGeneric("lM"))
10
-setGeneric("lM<-", function(object, value) standardGeneric("lM<-"))
9
+
11 10
 setGeneric("totalCopyNumber", function(object,...) standardGeneric("totalCopyNumber"))
12 11
 
12
+setGeneric("CA", function(object, i, j, ...) standardGeneric("CA"))
13
+setGeneric("CB", function(object, i, j, ...) standardGeneric("CB"))
14
+setGeneric("totalCopyNumber", function(object, i, j, ...) standardGeneric("totalCopyNumber"))
15
+
16
+
17
+## The generics below are for internal use with copy number methods
18
+## If we keep them in oligoClasses, we need to export and document
13 19
 setGeneric("corr", function(object, allele) standardGeneric("corr"))
14 20
 setGeneric("nu", function(object, allele) standardGeneric("nu"))
15 21
 setGeneric("phi", function(object, allele) standardGeneric("phi"))
16 22
 setGeneric("sigma2", function(object, allele) standardGeneric("sigma2"))
17 23
 setGeneric("tau2", function(object, allele) standardGeneric("tau2"))
18 24
 
19
-setGeneric("CA", function(object, i, j, ...) standardGeneric("CA"))
20
-setGeneric("CB", function(object, i, j, ...) standardGeneric("CB"))
21
-setGeneric("totalCopyNumber", function(object, i, j, ...) standardGeneric("totalCopyNumber"))
25
+setGeneric("nuA", function(object) standardGeneric("nuA"))
26
+setGeneric("nuB", function(object) standardGeneric("nuA"))
27
+setGeneric("phiA", function(object) standardGeneric("phiA"))
28
+setGeneric("phiB", function(object) standardGeneric("phiB"))
29
+setGeneric("sigma2A", function(object) standardGeneric("sigma2A"))
30
+setGeneric("sigma2B", function(object) standardGeneric("sigma2B"))
31
+setGeneric("tau2A", function(object) standardGeneric("tau2A"))
32
+setGeneric("tau2B", function(object) standardGeneric("tau2B"))
33
+setGeneric("corrAA", function(object) standardGeneric("corrAA"))
34
+setGeneric("corrBB", function(object) standardGeneric("corrBB"))
35
+setGeneric("corrAB", function(object) standardGeneric("corrAB"))
36
+
37
+setGeneric("nuA<-", function(object, value) standardGeneric("nuA<-"))
38
+setGeneric("nuB<-", function(object, value) standardGeneric("nuB<-"))
39
+setGeneric("phiA<-", function(object, value) standardGeneric("phiA<-"))
40
+setGeneric("phiB<-", function(object, value) standardGeneric("phiB<-"))
41
+setGeneric("sigma2A<-", function(object, value) standardGeneric("sigma2A<-"))
42
+setGeneric("sigma2B<-", function(object, value) standardGeneric("sigma2B<-"))
43
+setGeneric("tau2A<-", function(object, value) standardGeneric("tau2A<-"))
44
+setGeneric("tau2B<-", function(object, value) standardGeneric("tau2B<-"))
45
+setGeneric("corrAA<-", function(object, value) standardGeneric("corrAA<-"))
46
+setGeneric("corrAB<-", function(object, value) standardGeneric("corrAB<-"))
47
+setGeneric("corrBB<-", function(object, value) standardGeneric("corrBB<-"))
22 48
 
23 49
 
... ...
@@ -86,7 +86,7 @@ construct <- function(filenames, cdfName, copynumber=FALSE,
86 86
 	colnames(pd)=c("SKW", "SNR", "gender")
87 87
 	phenoData <- new("AnnotatedDataFrame", data=pd)
88 88
 	ffObjects <- lapply(ffObjects, function(x,sns) {colnames(x) <- sns; return(x)}, sns=sns)
89
-	callSet <- new("CNSetLM", 
89
+	callSet <- new("CNSet", 
90 90
 		       alleleA=ffObjects[["alleleA"]],
91 91
 		       alleleB=ffObjects[["alleleB"]],
92 92
 		       call=ffObjects[["call"]],
... ...
@@ -311,7 +311,7 @@ genotypeLD <- function(filenames,
311 311
 	callSet$gender <- tmp$gender
312 312
 	return(callSet)
313 313
 }
314
-genotype2 <- genotypeLD
314
+genotype <- genotype2 <- genotypeLD
315 315
 
316 316
 rowCovs <- function(x, y, ...){
317 317
 	notna <- !is.na(x)
... ...
@@ -774,7 +774,7 @@ crlmmCopynumberLD <- function(object,
774 774
 		 neededPkgs="crlmm")
775 775
 	return(object)
776 776
 }
777
-crlmmCopynumber2 <- crlmmCopynumberLD
777
+crlmmCopynumber <- crlmmCopynumber2 <- crlmmCopynumberLD
778 778
 
779 779
 fit.lm1 <- function(idxBatch,
780 780
 		    snpBatches,
... ...
@@ -2759,7 +2759,7 @@ constructIlluminaCNSet <- function(crlmmResult,
2759 2759
 	fD <- fD[new.order, ]
2760 2760
 	aD <- constructIlluminaAssayData(cnAB, res, crlmmResult, order.index=new.order)
2761 2761
 	protocolData(crlmmResult)$batch <- vector("integer", ncol(crlmmResult))
2762
-	container <- new("CNSetLM", 
2762
+	container <- new("CNSet", 
2763 2763
 			 assayData=aD,
2764 2764
 			 phenoData=phenoData(crlmmResult),
2765 2765
 			 protocolData=protocolData(crlmmResult),
... ...
@@ -1,110 +1,109 @@
1
-setMethod("show", "CNSetLM", function(object){
2
-	callNextMethod(object)
3
-	cat("lM: ", length(lM(object)), " elements \n")
4
-	print(names(lM(object)))
1
+linearParamElementReplace <- function(obj, elt, value) {
2
+    storage.mode <- storageMode(lM(obj))
3
+    switch(storage.mode,
4
+           "lockedEnvironment" = {
5
+               aData <- copyEnv(lM(obj))
6
+               if (is.null(value)) rm(list=elt, envir=aData)
7
+               else aData[[elt]] <- value
8
+               Biobase:::assayDataEnvLock(aData)
9
+               lM(obj) <- aData
10
+           },
11
+           "environment" = {
12
+               if (is.null(value)) rm(list=elt, envir=lM(obj))
13
+               else lM(obj)[[elt]] <- value
14
+           },
15
+           list = lM(obj)[[elt]] <- value)
16
+    obj
17
+}
18
+
19
+
20
+setMethod("nu", c("CNSet", "character"), function(object, allele) nu(lM(object), allele))
21
+setMethod("phi", c("CNSet", "character"), function(object, allele) phi(lM(object), allele))
22
+setMethod("sigma2", c("CNSet", "character"), function(object, allele) phi(lM(object), allele))
23
+setMethod("tau2", c("CNSet", "character"), function(object, allele) phi(lM(object), allele))
24
+setMethod("corr", c("CNSet", "character"), function(object, allele) phi(lM(object), allele))
25
+
26
+setMethod("nuA", signature=signature(object="CNSet"), function(object) nu(object, "A"))
27
+setMethod("nuB", signature=signature(object="CNSet"), function(object) nu(object, "B"))
28
+setMethod("phiA", signature=signature(object="CNSet"), function(object) phi(object, "A"))
29
+setMethod("phiB", signature=signature(object="CNSet"), function(object) phi(object, "B"))
30
+setMethod("sigma2A", signature=signature(object="CNSet"), function(object) sigma2(object, "A"))
31
+setMethod("sigma2B", signature=signature(object="CNSet"), function(object) sigma2(object, "B"))
32
+setMethod("tau2A", signature=signature(object="CNSet"), function(object) tau2(object, "A"))
33
+setMethod("tau2B", signature=signature(object="CNSet"), function(object) tau2(object, "B"))
34
+setMethod("corrAA", signature=signature(object="CNSet"), function(object) corr(object, "AA"))
35
+setMethod("corrAB", signature=signature(object="CNSet"), function(object) corr(object, "AB"))
36
+setMethod("corrBB", signature=signature(object="CNSet"), function(object) corr(object, "BB"))
37
+
38
+setReplaceMethod("nuA", signature=signature(object="CNSet", value="matrix"), 
39
+	  function(object, value){
40
+		  linearParamElementReplace(object, "nuA", value)
41
+	  })
42
+
43
+setReplaceMethod("nuB", signature=signature(object="CNSet", value="matrix"), 
44
+	  function(object, value){
45
+		  linearParamElementReplace(object, "nuB", value)		  
5 46
 })
6 47
 
7
-setMethod("[", "CNSetLM", function(x, i, j, ..., drop=FALSE){
8
-	x <- callNextMethod(x, i, j, ..., drop=drop)
9
-	if(!missing(i)){
10
-		if(class(lM(x)) == "ffdf"){
11
-			lM(x) <- lapply(physical(lM(x)), function(x, i){open(x); x[i, ]}, i=i)
12
-		} else {
13
-			lM(x) <- lapply(lM(x), function(x, i) x[i, , drop=FALSE], i=i)
14
-		}
15
-	}
16
-	x
48
+setReplaceMethod("phiA", signature=signature(object="CNSet", value="matrix"), 
49
+	  function(object, value){
50
+		  linearParamElementReplace(object, "phiA", value)		  
17 51
 })
18 52
 
19
-setMethod("[", "CNSetLM", function(x, i, j, ..., drop=FALSE){
20
-	x <- callNextMethod(x, i, j, ..., drop=drop)
21
-##	if(!missing(i)){
22
-##		if(class(lM(x)) == "ffdf"){
23
-##			lM(x) <- lapply(physical(lM(x)), function(x, i){open(x); x[i, ]}, i=i)
24
-##		} else {
25
-##			lM(x) <- lapply(lM(x), function(x, i) x[i, , drop=FALSE], i=i)
26
-##		}
27
-##	}
28
-	x
53
+setReplaceMethod("phiB", signature=signature(object="CNSet", value="matrix"), 
54
+	  function(object, value){
55
+		  linearParamElementReplace(object, "phiB", value)		  
29 56
 })
30 57
 
58
+setReplaceMethod("sigma2A", signature=signature(object="CNSet", value="matrix"), 
59
+	  function(object, value){
60
+		  linearParamElementReplace(object, "sig2A", value)		  
61
+})
31 62
 
32
-setMethod("lM", "CNSetLM", function(object) object@lM)
33
-setReplaceMethod("lM", c("CNSetLM", "list_or_ffdf"), function(object, value){
34
-	object@lM <- value
35
-	object
63
+setReplaceMethod("sigma2B", signature=signature(object="CNSet", value="matrix"), 
64
+	  function(object, value){
65
+		  linearParamElementReplace(object, "sig2B", value)		  
36 66
 })
37 67
 
68
+setReplaceMethod("tau2A", signature=signature(object="CNSet", value="matrix"), 
69
+	  function(object, value){
70
+		  linearParamElementReplace(object, "tau2A", value)		  
71
+})
38 72
 
73
+setReplaceMethod("tau2B", signature=signature(object="CNSet", value="matrix"), 
74
+	  function(object, value){
75
+		  linearParamElementReplace(object, "tau2B", value)		  
76
+})
39 77
 
40
-setMethod("open", "CNSetLM", function(con,...){
41
-	callNextMethod(con,...)
42
-	physical <- get("physical")
43
-	lapply(physical(lM(con)), open)
78
+setReplaceMethod("corrAA", signature=signature(object="CNSet", value="matrix"), 
79
+	  function(object, value){
80
+		  linearParamElementReplace(object, "corrAA", value)		  
44 81
 })
45 82
 
46
-setAs("SnpSuperSet", "CNSetLM", function(from, to){
47
-	stopifnot("batch" %in% varLabels(protocolData(from)))
48
-	cnSet <- new("CNSetLM",
49
-		     alleleA=A(from),
50
-		     alleleB=B(from),
51
-		     call=snpCall(from),
52
-		     callProbability=snpCallProbability(from),
53
-##		     CA=initializeBigMatrix("CA", nrow(from), ncol(from)),
54
-##		     CB=initializeBigMatrix("CB", nrow(from), ncol(from)),
55
-		     annotation=annotation(from),
56
-		     featureData=featureData(from),
57
-		     experimentData=experimentData(from),
58
-		     protocolData=protocolData(from),
59
-		     phenoData=phenoData(from))
60
-	lM(cnSet) <- initializeParamObject(list(featureNames(cnSet), unique(protocolData(from)$batch)))
61
-	return(cnSet)
83
+setReplaceMethod("corrAB", signature=signature(object="CNSet", value="matrix"), 
84
+	  function(object, value){
85
+		  linearParamElementReplace(object, "corrAB", value)		  
62 86
 })
63 87
 
64
-setMethod("computeCopynumber", "CNSet",
65
-	  function(object,
66
-		   MIN.OBS,
67
-		   DF.PRIOR,
68
-		   bias.adj,
69
-		   prior.prob,
70
-		   seed,
71
-		   verbose,
72
-		   GT.CONF.THR,
73
-		   PHI.THR,
74
-		   nHOM.THR,
75
-		   MIN.NU,
76
-		   MIN.PHI,
77
-		   THR.NU.PHI,
78
-		   thresholdCopynumber){
79
-	## to do the bias adjustment, initial estimates of the parameters are needed
80
-	##  The initial estimates are gotten by running computeCopynumber with cnOptions[["bias.adj"]]=FALSE
81
-		  cnOptions <- list(
82
-				    MIN.OBS=MIN.OBS,
83
-				    DF.PRIOR=DF.PRIOR,
84
-				    bias.adj=bias.adj,
85
-				    prior.prob=prior.prob,
86
-				    seed=seed,
87
-				    verbose=verbose,
88
-				    GT.CONF.THR=GT.CONF.THR,
89
-				    PHI.THR=PHI.THR,
90
-				    nHOM.THR=nHOM.THR,
91
-				    MIN.NU=MIN.NU,
92
-				    MIN.PHI=MIN.PHI,
93
-				    THR.NU.PHI=THR.NU.PHI,
94
-				    thresholdCopynumber=thresholdCopynumber)
95
-	bias.adj <- cnOptions[["bias.adj"]]
96
-	if(bias.adj & all(is.na(fData(object)$nuA_1))){
97
-		cnOptions[["bias.adj"]] <- FALSE
98
-	}
99
-	object <- cnCNSet(object, cnOptions)				
100
-	if(bias.adj & !cnOptions[["bias.adj"]]){
101
-		## Do a second iteration with bias adjustment
102
-		cnOptions[["bias.adj"]] <- TRUE
103
-		object <- cnCNSet(object, cnOptions)
104
-	}
105
-	object
88
+setReplaceMethod("corrBB", signature=signature(object="CNSet", value="matrix"), 
89
+	  function(object, value){
90
+		  linearParamElementReplace(object, "corrBB", value)		  
106 91
 })
107 92
 
93
+
94
+##setValidity("CNSet",
95
+##	    function(object){
96
+##		    if(!"batch" %in% varLabels(protocolData(object)))
97
+##			    return("'batch' not defined in protocolData")
98
+##		    if(!"chromosome" %in% fvarLabels(object))
99
+##			    return("'chromosome' not defined in featureData")
100
+##		    if(!"position" %in% fvarLabels(object))
101
+##			    return("'position' not defined in featureData")
102
+##		    if(!"isSnp" %in% fvarLabels(object))
103
+##			    return("'isSnp' not defined in featureData")
104
+##		    return(TRUE)
105
+##	    })
106
+
108 107
 setMethod("totalCopyNumber", "CNSet", function(object, i, j){
109 108
 	if(missing(i) & missing(j)){
110 109
 		if(inherits(CA(object), "ff") | inherits(CA(object), "ffdf")) stop("Must specify i and/or j for ff objects")
... ...
@@ -132,110 +131,11 @@ setMethod("totalCopyNumber", "CNSet", function(object, i, j){
132 131
 	return(cn.total)
133 132
 })
134 133
 
135
-setMethod("ellipse", "CNSet", function(x, copynumber, batch, ...){
136
-	ellipse.CNSet(x, copynumber, batch, ...)
137
-})
138
-
139
-setMethod("nu", c("CNSetLM", "character"), function(object, allele){
140
-	getValue <- function(allele){
141
-		switch(allele,
142
-		       A="nuA",
143
-		       B="nuB",
144
-		       stop("allele must be 'A' or 'B'"))
145
-	}	
146
-	val <- getValue(allele)
147
-	class.lm <- class(lM(object)) 
148
-	if(class.lm == "ffdf"){
149
-		physical <- get("physical")
150
-		res <- physical(lM(object))[[val]]
151
-
152
-	} else {
153
-		if(class.lm != "list") stop("lM() must be matrix or ffdf")
154
-		res <- lM(object)[[val]]
155
-	}
156
-	return(res)
157
-})
158
-
159
-setMethod("phi", c("CNSetLM", "character"), function(object, allele){
160
-	getValue <- function(allele){
161
-		switch(allele,
162
-		       A="phiA",
163
-		       B="phiB",
164
-		       stop("allele must be 'A' or 'B'"))
165
-	}
166
-	val <- getValue(allele)	
167
-	class.lm <- class(lM(object)) 
168
-	if(class.lm == "ffdf"){
169
-		physical <- get("physical")
170
-		res <- physical(lM(object))[[val]]
171
-
172
-	} else {
173
-		if(class.lm != "list") stop("lM() must be matrix or ffdf")
174
-		res <- lM(object)[[val]]
175
-	}
176
-	return(res)
177
-})
178
-
179
-setMethod("sigma2", c("CNSetLM", "character"), function(object, allele){
180
-	getValue <- function(allele){
181
-		switch(allele,
182
-		       A="sig2A",
183
-		       B="sig2B",
184
-		       stop("allele must be 'A' or 'B'"))
185
-	}
186
-	val <- getValue(allele)	
187
-	class.lm <- class(lM(object))
188
-	if(class.lm == "ffdf"){
189
-		physical <- get("physical")
190
-		res <- physical(lM(object))[[val]]
134
+##setMethod("ellipse", "CNSet", function(x, copynumber, batch, ...){
135
+##	ellipse.CNSet(x, copynumber, batch, ...)
136
+##})
191 137
 
192
-	} else {
193
-		if(class.lm != "list") stop("lM() must be matrix or ffdf")
194
-		res <- lM(object)[[val]]
195
-	}
196
-	return(res)
197
-})
198 138
 
199
-setMethod("tau2", c("CNSetLM", "character"), function(object, allele){
200
-	getValue <- function(allele){
201
-		switch(allele,
202
-		       A="tau2A",
203
-		       B="tau2B",
204
-		       stop("allele must be 'A' or 'B'"))
205
-	}
206
-	val <- getValue(allele)
207
-	class.lm <- class(lM(object))
208
-	if(class.lm == "ffdf"){
209
-		physical <- get("physical")
210
-		res <- physical(lM(object))[[val]]
211
-
212
-	} else {
213
-		if(class.lm != "list") stop("lM() must be matrix or ffdf")
214
-		res <- lM(object)[[val]]
215
-	}
216
-	return(res)
217
-})
218
-
219
-setMethod("corr", c("CNSetLM", "character"), function(object, allele){
220
-	getValue <- function(allele){
221
-		switch(allele,
222
-		       AA="corrAA",
223
-		       AB="corrAB",
224
-		       BB="corrBB",
225
-		       stop("must be AA, AB, or BB"))
226
-	}
227
-	val <- getValue(allele)
228
-	class.lm <- class(lM(object))
229
-	if(class.lm == "ffdf"){
230
-		physical <- get("physical")
231
-		res <- physical(lM(object))[[val]]
232
-
233
-	} else {
234
-		if(class.lm != "list") stop("lM() must be matrix or ffdf")
235
-		res <- lM(object)[[val]]
236
-	}
237
-	return(res)
238
-})
239 139
 
240 140
 ACN <- function(object, allele, i , j){
241 141
 	if(missing(i) & missing(j)){
... ...
@@ -328,3 +228,12 @@ setMethod("totalCopyNumber",
328 228
 	dimnames(cn.total) <- NULL
329 229
 	return(cn.total)
330 230
 })
231
+
232
+setReplaceMethod("snpCall", c("CNSet", "ff_or_matrix"),
233
+                 function(object, ..., value){
234
+			 assayDataElementReplace(object, "call", value)
235
+		 })
236
+setReplaceMethod("snpCallProbability", c("CNSet", "ff_or_matrix"),
237
+                 function(object, ..., value){
238
+			 assayDataElementReplace(object, "callProbability", value)
239
+		 })
331 240
new file mode 100644
... ...
@@ -0,0 +1,62 @@
1
+setMethod("nu", c("LinearModelParameter", "character"), 
2
+	  function(object, allele){
3
+		  getValue <- function(allele){
4
+			  switch(allele,
5
+				 A="nuA",
6
+				 B="nuB",
7
+				 stop("allele must be 'A' or 'B'"))
8
+		  }	
9
+		  val <- getValue(allele)
10
+		  assayDataElement(object, val)
11
+})
12
+
13
+
14
+
15
+setMethod("phi", c("LinearModelParameter", "character"),
16
+	  function(object, allele){
17
+		  getValue <- function(allele){
18
+			  switch(allele,
19
+				 A="phiA",
20
+				 B="phiB",
21
+				 stop("allele must be 'A' or 'B'"))
22
+		  }	
23
+		  val <- getValue(allele)
24
+		  assayDataElement(object, val)
25
+	  })
26
+
27
+setMethod("sigma2", c("LinearModelParameter", "character"),
28
+	  function(object, allele){
29
+		  getValue <- function(allele){
30
+			  switch(allele,
31
+				 A="sigma2A",
32
+				 B="sigma2B",
33
+				 stop("allele must be 'A' or 'B'"))
34
+		  }
35
+		  val <- getValue(allele)
36
+		  assayDataElement(object, val)
37
+	  })
38
+
39
+setMethod("tau2", c("LinearModelParameter", "character"),
40
+	  function(object, allele){
41
+		  getValue <- function(allele){
42
+			  switch(allele,
43
+				 A="tau2A",
44
+				 B="tau2B",
45
+				 stop("allele must be 'A' or 'B'"))
46
+		  }
47
+		  val <- getValue(allele)		  
48
+		  assayDataElement(object, val)
49
+	  })
50
+
51
+setMethod("corr", c("LinearModelParameter", "character"),
52
+	  function(object, allele){
53
+		  getValue <- function(allele){
54
+			  switch(allele,
55
+				 AA="corrAA",
56
+				 AB="corrAB",
57
+				 BB="corrBB",
58
+				 stop("allele must be 'AA', 'AB', or 'BB'"))
59
+		  }
60
+		  val <- getValue(allele)		  
61
+		  assayDataElement(object, val)
62
+	  })
... ...
@@ -1,15 +1,3 @@
1
-setReplaceMethod("snpCall", c("SnpSuperSet", "ff_or_matrix"),
2
-                 function(object, ..., value)
3
-{
4
-    assayDataElementReplace(object, "call", value)
5
-})
6
-setReplaceMethod("snpCallProbability", c("SnpSuperSet", "ff_or_matrix"),
7
-                 function(object, ..., value)
8
-{
9
-    assayDataElementReplace(object, "callProbability", value)
10
-})
11
-
12
-
13 1
 ## Method("initialize", "AlleleSet",
14 2
 ##        function(.Object,
15 3
 ##                 assayData = assayDataNew(alleleA=alleleA,
... ...
@@ -153,23 +141,23 @@ setReplaceMethod("snpCallProbability", c("SnpSuperSet", "ff_or_matrix"),
153 141
 ##	addFeatureAnnotation.crlmm(object, ...)
154 142
 ##})
155 143
 
156
-getParam.SnpSuperSet <- function(object, name, batch){
157
-		  label <- paste(name, batch, sep="_")
158
-		  colindex <- grep(label, fvarLabels(object))
159
-		  if(length(colindex) == 1){
160
-			  param <- fData(object)[, colindex]
161
-		  }
162
-		  if(length(colindex) < 1){
163
-			  param <- NULL
164
-		  }
165
-		  if(is.na(colindex)){
166
-			  stop(paste(label, " not found in object"))
167
-		  }
168
-		  if(length(colindex) > 1){
169
-			  stop(paste(label, " not unique"))
170
-		  }
171
-		  return(param)
172
-	  }
144
+##getParam.SnpSuperSet <- function(object, name, batch){
145
+##		  label <- paste(name, batch, sep="_")
146
+##		  colindex <- grep(label, fvarLabels(object))
147
+##		  if(length(colindex) == 1){
148
+##			  param <- fData(object)[, colindex]
149
+##		  }
150
+##		  if(length(colindex) < 1){
151
+##			  param <- NULL
152
+##		  }
153
+##		  if(is.na(colindex)){
154
+##			  stop(paste(label, " not found in object"))
155
+##		  }
156
+##		  if(length(colindex) > 1){
157
+##			  stop(paste(label, " not unique"))
158
+##		  }
159
+##		  return(param)
160
+##	  }
173 161
 
174 162
 
175 163
 
... ...
@@ -1,8 +1,7 @@
1
-setOldClass("ellipse")
2 1
 setMethod("lines", c("CNSetLM"), function(x, y, batch, copynumber, ...){
3
-	linesCNSetLM(x, y, batch, copynumber, ...)
2
+	linesCNSet(x, y, batch, copynumber, ...)
4 3
 })
5
-linesCNSetLM <- function(x, y, batch, copynumber, x.axis="A", ...){
4
+linesCNSet <- function(x, y, batch, copynumber, x.axis="A", ...){
6 5
 	require(ellipse)
7 6
 	object <- x
8 7
 	I <- y
... ...
@@ -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)
229 215
deleted file mode 100644
... ...
@@ -1,75 +0,0 @@
1
-\name{CNSetLM-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{CNSetLM}
5
-\alias{CNSetLM-class}
6
-\alias{[,CNSetLM-method}
7
-\alias{corr,CNSetLM,character-method}
8
-\alias{lines,CNSetLM-method}
9
-\alias{lM,CNSetLM-method}
10
-\alias{lM<-,CNSetLM,list_or_ffdf-method}
11
-\alias{open,CNSetLM-method}
12
-\alias{nu,CNSetLM,character-method}
13
-\alias{phi,CNSetLM,character-method}
14
-\alias{show,CNSetLM-method}
15
-\alias{sigma2,CNSetLM,character-method}
16
-\alias{tau2,CNSetLM,character-method}
17
-
18
-\title{CNSetLM class}
19
-\description{Container for allele-specific copy number and linear model
20
-parameters}
21
-\section{Objects from the Class}{
22
-		 Objects from the class can be created by calls of the
23
-		 form \code{ new("CNSetLM", CA=matrix(), CB=matrix(), alleleA=matrix(), alleleB=matrix(), call=matrix(), callProbability=matrix())}
24
-		 
25
-}
26
-\section{Slots}{
27
-  \describe{
28
-    \item{\code{lM}:}{Object of class \code{"list_or_ffdf"}}
29
-    \item{\code{assayData}:}{Object of class \code{"AssayData"} }
30
-    \item{\code{phenoData}:}{Object of class \code{"AnnotatedDataFrame"} }
31
-    \item{\code{featureData}:}{Object of class \code{"AnnotatedDataFrame"} }
32
-    \item{\code{experimentData}:}{Object of class \code{"MIAME"} }
33
-    \item{\code{annotation}:}{Object of class \code{"character"}  }
34
-    \item{\code{protocolData}:}{Object of class \code{"AnnotatedDataFrame"} }
35
-    \item{\code{.__classVersion__}:}{Object of class \code{"Versions"} }
36
-  }
37
-}
38
-\section{Extends}{
39
-Class \code{"\linkS4class{CNSet}"}, directly.
40
-Class \code{"\linkS4class{SnpSuperSet}"}, by class "CNSet", distance 2.
41
-Class \code{"\linkS4class{AlleleSet}"}, by class "CNSet", distance 3.
42
-Class \code{"\linkS4class{SnpSet}"}, by class "CNSet", distance 3.
43
-Class \code{"\linkS4class{eSet}"}, by class "CNSet", distance 4.
44
-Class \code{"\linkS4class{VersionedBiobase}"}, by class "CNSet", distance 5.
45
-Class \code{"\linkS4class{Versioned}"}, by class "CNSet", distance 6.
46
-}
47
-\section{Methods}{
48
-  \describe{
49
-    \item{[}{\code{signature(x = "CNSetLM")}: subset \code{CNSetLM} objects}
50
-    \item{lines}{\code{signature(x="CNSetLM")}: for drawing prediction regions on A vs B scatterplots}
51
-    \item{lM}{\code{signature(object = "CNSetLM")}: Extract list or
52
-    ffdf object containing linear model parameters}
53
-    \item{nu}{\code{signature(object = "CNSetLM", allele="character")}: 
54
-            intercept for linear model. See \code{\link{nu}}}
55
-    \item{open}{\code{signature(con = "CNSetLM")}: opens file connection
56
-               to ff objects for assayData elements and linear model parameters}
57
-    \item{phi}{\code{signature(object = "CNSetLM", allele="character")}: 
58
-               slope for linear model.  See \code{\link{phi}}.}
59
-    \item{show}{\code{signature(object = "CNSetLM")}: print method
60
-                 for the class }
61
-    \item{sigma2}{\code{signature(object = "CNSetLM", allele="character")}: 
62
-                  Accessor for log2 intensity variance among subjects with genotype AA (allele 'A') and genotype BB (allele 'B')
63
-	     }
64
-}
65
-}
66
-
67
-\author{ R. Scharpf}
68
-\seealso{
69
-	\code{\linkS4class{SnpSuperSet}}, \code{\linkS4class{CNSet}}
70
-}
71
-
72
-\examples{
73
-showClass("CNSetLM")
74
-}
75
-\keyword{classes}
... ...
@@ -37,7 +37,7 @@ constructIlluminaCNSet(crlmmResult, path, snpFile, cnFile)
37 37
 R. Scharpf
38 38
 }
39 39
 \seealso{
40
-	\code{\link{CNSetLM-class}}, \code{\link{crlmmIllumina}}
40
+	\code{\link{CNSet-class}}, \code{\link{crlmmIllumina}}
41 41
 }
42 42
 
43 43
 \keyword{manip}
... ...
@@ -7,17 +7,17 @@
7 7
   Locus- and allele-specific estimation of copy number.
8 8
 }
9 9
 \usage{
10
-crlmmCopynumber(object, chromosome = 1:23, which.batches, MIN.SAMPLES
11
-= 10, SNRMin = 5, MIN.OBS = 3, DF.PRIOR = 50, bias.adj = FALSE,
12
-prior.prob = rep(1/4, 4), seed = 1, verbose = TRUE, GT.CONF.THR =
13
-0.99, PHI.THR = 2^6, nHOM.THR = 5, MIN.NU = 2^3, MIN.PHI = 2^3,
14
-THR.NU.PHI = TRUE, thresholdCopynumber = TRUE, weighted.lm=TRUE)
10
+%crlmmCopynumber(object, chromosome = 1:23, which.batches, MIN.SAMPLES
11
+%= 10, SNRMin = 5, MIN.OBS = 3, DF.PRIOR = 50, bias.adj = FALSE,
12
+%prior.prob = rep(1/4, 4), seed = 1, verbose = TRUE, GT.CONF.THR =
13
+%0.99, PHI.THR = 2^6, nHOM.THR = 5, MIN.NU = 2^3, MIN.PHI = 2^3,
14
+%THR.NU.PHI = TRUE, thresholdCopynumber = TRUE)
15 15
 
16 16
 crlmmCopynumberLD(object, which.batches, MIN.SAMPLES = 10, SNRMin = 5,
17 17
 MIN.OBS = 1, DF.PRIOR = 50, bias.adj = FALSE, prior.prob = rep(1/4,
18 18
 4), seed = 1, verbose = TRUE, GT.CONF.THR = 0.99, PHI.THR = 2^6,
19 19
 nHOM.THR = 5, MIN.NU = 2^3, MIN.PHI = 2^3, THR.NU.PHI = TRUE,
20
-thresholdCopynumber = TRUE, weighted.lm=TRUE)
20
+thresholdCopynumber = TRUE)
21 21
 
22 22
 }
23 23
 \arguments{
... ...
@@ -137,11 +137,6 @@ thresholdCopynumber = TRUE, weighted.lm=TRUE)
137 137
 
138 138
 }
139 139
 
140
-\item{weighted.lm}{ If \code{TRUE}, a linear model is fit using
141
-weighted least squares. Otherwise, a linear model is fit without
142
-weights. The run-time for weighted least squares is substantially
143
-longer.}
144
-
145 140
 }
146 141
 
147 142
 \details{
... ...
@@ -68,7 +68,7 @@ R. Scharpf
68 68
 }
69 69
 
70 70
 \seealso{
71
-	\code{\link{CNSetLM-class}}
71
+	\code{\link{CNSet-class}}
72 72
 }
73 73
 \examples{
74 74
 ## object with ff class
... ...
@@ -13,7 +13,7 @@
13 13
 \usage{data(sample.CNSetLM)}
14 14
 \format{
15 15
 
16
-	The data illustrates the \code{\link{CNSetLM-class}}, with
16
+	The data illustrates the \code{CNSetLM-class}, with
17 17
 	\code{assayData} containing the quantile-normalized
18 18
 	intensities for the A and B alleles, genotype calls and
19 19
 	confidence scores (call and callProbability), and