1. crlmm
  2. R
  3. methods-SnpSuperSet.R
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ 97e84a8
... ... 
@@ -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
Browse code

changed computeCopynumber.CNSet to cnCNSet and commented thresholdCopynumber() in cnCNSet.

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

Rob Scharp authored on 21/08/2010 02:48:31
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ 2551de7
... ... 
@@ -212,9 +212,9 @@ getParam.SnpSuperSet <- function(object, name, batch){
212 212 
 ##	saved.objects
213 213 
 ##})
214 214
215 
-setMethod("computeCopynumber", "SnpSuperSet",
216 
-	  function(object, cnOptions){
217 
-		  computeCopynumber.SnpSuperSet(object, cnOptions)
218 
-	  })
215 
+##setMethod("computeCopynumber", "SnpSuperSet",
216 
+##	  function(object, cnOptions){
217 
+##		  computeCopynumber.SnpSuperSet(object, cnOptions)
218 
+##	  })
219 219
220 220
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ afb508f
... ... 
@@ -1,3 +1,15 @@
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 
+
1 13 
 ## Method("initialize", "AlleleSet",
2 14 
 ##        function(.Object,
3 15 
 ##                 assayData = assayDataNew(alleleA=alleleA,
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ 5fcfed7
... ... 
@@ -142,17 +142,22 @@
142 142 
 ##})
143 143
144 144 
 getParam.SnpSuperSet <- function(object, name, batch){
145 
-	if(missing(batch)) label <- name
146 
-	else  label <- paste(name, batch, sep="_")
147 
-	colindex <- grep(label, fvarLabels(object))
148 
-	if(length(colindex) >= 1){
149 
-		param <- fData(object)[, colindex]
150 
-	} else param <- NULL
151 
-	if(any(is.na(colindex))){
152 
-		stop(paste(label, " not found in object"))
153 
-	}
154 
-	return(param)
155 
-}
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 
+	  }
156 161
157 162
158 163
... ... 
@@ -195,9 +200,9 @@ getParam.SnpSuperSet <- function(object, name, batch){
195 200 
 ##	saved.objects
196 201 
 ##})
197 202
198 
-##setMethod("computeCopynumber", "SnpSuperSet",
199 
-##	  function(object, cnOptions){
200 
-##		  computeCopynumber.SnpSuperSet(object, cnOptions)
201 
-##	  })
203 
+setMethod("computeCopynumber", "SnpSuperSet",
204 
+	  function(object, cnOptions){
205 
+		  computeCopynumber.SnpSuperSet(object, cnOptions)
206 
+	  })
202 207
203 208
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ a13f66d
... ... 
@@ -195,9 +195,9 @@ getParam.SnpSuperSet <- function(object, name, batch){
195 195 
 ##	saved.objects
196 196 
 ##})
197 197
198 
-setMethod("computeCopynumber", "SnpSuperSet",
199 
-	  function(object, cnOptions){
200 
-		  computeCopynumber.SnpSuperSet(object, cnOptions)
201 
-	  })
198 
+##setMethod("computeCopynumber", "SnpSuperSet",
199 
+##	  function(object, cnOptions){
200 
+##		  computeCopynumber.SnpSuperSet(object, cnOptions)
201 
+##	  })
202 202
203 203
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ 7e1d14d
... ... 
@@ -142,22 +142,17 @@
142 142 
 ##})
143 143
144 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 
-	  }
145 
+	if(missing(batch)) label <- name
146 
+	else  label <- paste(name, batch, sep="_")
147 
+	colindex <- grep(label, fvarLabels(object))
148 
+	if(length(colindex) >= 1){
149 
+		param <- fData(object)[, colindex]
150 
+	} else param <- NULL
151 
+	if(any(is.na(colindex))){
152 
+		stop(paste(label, " not found in object"))
153 
+	}
154 
+	return(param)
155 
+}
161 156
162 157
163 158
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ 82be31d
... ... 
@@ -1,48 +1,145 @@
1 
-##How to make the initialization platform-specific?
1 
+## Method("initialize", "AlleleSet",
2 
+##        function(.Object,
3 
+##                 assayData = assayDataNew(alleleA=alleleA,
4 
+##                                          alleleB=alleleB, ...),
5 
+##                 phenoData = annotatedDataFrameFrom(assayData, byrow=FALSE),
6 
+##                 featureData = annotatedDataFrameFrom(assayData, byrow=TRUE),
7 
+##                 experimentData = new("MIAME"),
8 
+##                 annotation = character(),
9 
+##                 protocolData = phenoData[,integer(0)],
10 
+##                 alleleA = new("matrix"),
11 
+##                 alleleB = matrix(numeric(),
12 
+## 		                    nrow=nrow(alleleA), ncol=ncol(alleleA),
13 
+##                                  dimnames=dimnames(alleleA)),
14 
+## 		   chromosome=integer(),
15 
+## 		   position=integer(),
16 
+## 		   isSnp=integer(),
17 
+##                 ...) {
18 
+## 		  .Object <- callNextMethod(.Object,
19 
+## 					    assayData = assayData,
20 
+## 					    phenoData = phenoData,
21 
+## 					    featureData = featureData,
22 
+## 					    experimentData = experimentData,
23 
+## 					    annotation = annotation,
24 
+## 					    protocolData = protocolData)
25 
+## 		  if(length(annotation) < 1){
26 
+## 			  if((length(position) < 1 | length(chromosome) < 1| length(isSnp) < 1)){
27 
+## 				  stop("must specify annotation if 'chromosome', 'position', and 'isSnp' are missing")
28 
+## 			  } else {
29 
+## 				  pData(featureData)$chromosome <- chromosome
30 
+## 				  pData(featureData)$position <- position
31 
+## 				  pData(featureData)$isSnp <- isSnp
32 
+## 			  }
33 
+## 		  } else{
34 
+## 			  .Object@annotation <- annotation
35 
+## 			  if((length(position) < 1 | length(chromosome) < 1| length(isSnp) < 1)){
36 
+## 				  if(!isSupportedAnnotation(annotation)){
37 
+## 					  stop("The annotation is not supported. Arguments 'chromosome', 'position', and 'isSnp' can be omitted from the initialization only if the annotation is supported (see oligoClasses:::supportedAnnotation()).")
38 
+## 				  }
39 
+## 			  } else {
40 
+## 				  pData(featureData)$chromosome <- chromosome
41 
+## 				  pData(featureData)$position <- position
42 
+## 				  pData(featureData)$isSnp <- isSnp
43 
+## 			  }
44 
+## 			  .Object@featureData <- featureData
45 
+## 		  }
46 
+## 		  ## Do after annotation has been assigned
47 
+## 		  if(!(all(c("chromosome", "position", "isSnp") %in% varLabels(featureData))) & isSupportedAnnotation(annotation)){
48 
+## 			  ##update the featureData
49 
+## 			  .Object@featureData <- addFeatureAnnotation.crlmm(.Object)
50 
+## 		  }
51 
+## 		  .Object
52 
+##        })
53 
+##
54 
+## ow to make the initialization platform-specific?
55 
+## Method("initialize", "SnpSuperSet",
56 
+##        function(.Object,
57 
+## 		   call=new("matrix"),
58 
+##                 callProbability=matrix(NA, nrow(call), ncol(call), dimnames=dimnames(call)),
59 
+##                 phenoData = annotatedDataFrameFrom(assayData, byrow=FALSE),
60 
+## 		   featureData=annotatedDataFrameFrom(assayData, byrow=TRUE),
61 
+## 		   experimentData=new("MIAME"),
62 
+## 		   annotation=character(),
63 
+## 		   protocolData=phenoData[, integer(0)],
64 
+## 		   position=integer(),
65 
+## 		   chromosome=integer(),
66 
+## 		   isSnp=integer(),...){
67 
+## 		  .Object <- callNextMethod(.Object,
68 
+## 					    call=call,
69 
+## 					    callProbability=callProbability,
70 
+## 					    phenoData=phenoData,
71 
+## 					    featureData=featureData,
72 
+## 					    experimentData=experimentData,
73 
+## 					    annotation=annotation,
74 
+## 					    protocolData=protocolData,
75 
+## 					    position=position,
76 
+## 					    chromosome=chromosome,
77 
+## 					    isSnp=isSnp, ...)
78 
+##        })
79 
+##
80 
+
81 
+##setMethod("initialize", "SnpSuperSet",
82 
+##          function(.Object,
83 
+##		   call=new("matrix"),
84 
+##                   callProbability=matrix(NA, nrow(call), ncol(call), dimnames=dimnames(call)),
85 
+##                   alleleA = new("matrix"),
86 
+##                   alleleB = matrix(numeric(),
87 
+##		                    nrow=nrow(alleleA), ncol=ncol(alleleA),
88 
+##                                    dimnames=dimnames(alleleA)),
89 
+##                   phenoData = annotatedDataFrameFrom(call, byrow=FALSE),
90 
+##		   featureData=annotatedDataFrameFrom(call, byrow=TRUE),
91 
+##		   experimentData=new("MIAME"),
92 
+##		   protocolData=phenoData[, integer(0)],
93 
+##		   position=integer(),
94 
+##		   chromosome=integer(),
95 
+##		   isSnp=integer(),
96 
+##		   annotation=character(), ... ){
97 
+##		  ##browser()
98 
+##		  ##the ... should be additional assayDataElements, if any
99 
+##		  .Object <- callNextMethod(.Object,
100 
+##					    call=call,
101 
+##					    callProbability=callProbability,
102 
+##					    alleleA=alleleA,
103 
+##					    alleleB=alleleB,
104 
+##					    phenoData=phenoData,
105 
+##					    featureData=featureData,
106 
+##					    experimentData=experimentData,
107 
+##					    protocolData=protocolData,
108 
+##					    annotation=annotation, ...)
109 
+##		  annotation <- .Object@annotation
110 
+##		  ##add chromosome, position, isSnp to featureData
111 
+##		  if(length(annotation) < 1){
112 
+##			  if((length(position) < 1| length(chromosome) < 1 | length(isSnp) < 1)){
113 
+##				  stop("must specify annotation if 'chromosome', 'position', and 'isSnp' are missing")
114 
+##			  } else {
115 
+##				  pData(featureData)$chromosome <- chromosome
116 
+##				  pData(featureData)$position <- position
117 
+##				  pData(featureData)$isSnp <- isSnp
118 
+##			  }
119 
+##		  } else{
120 
+##			  if((length(position) < 1| length(chromosome) < 1 | length(isSnp) < 1)){
121 
+##				  if(!isSupportedAnnotation(annotation)){
122 
+##					  stop("The annotation is not supported. Arguments 'chromosome', 'position', and 'isSnp' can be omitted from the initialization only if the annotation is supported (see oligoClasses:::supportedAnnotation()).")
123 
+##				  }
124 
+##			  } else {
125 
+##				  pData(featureData)$chromosome <- chromosome
126 
+##				  pData(featureData)$position <- position
127 
+##				  pData(featureData)$isSnp <- isSnp
128 
+##			  }
129 
+##			  .Object@featureData <- featureData
130 
+##		  }
131 
+##		  ##Do after annotation has been assigned
132 
+##		  if(!(all(c("chromosome", "position", "isSnp") %in% varLabels(featureData))) & isSupportedAnnotation(annotation)){
133 
+##			  .Object@featureData <- addFeatureAnnotation.crlmm(.Object)
134 
+##		  }
135 
+##		  .Object
136 
+##          })
137 
+
2 138
3 
-setMethod("initialize", "SnpSuperSet",
4 
-          function(.Object,
5 
-		   assayData,
6 
-                   call=new("matrix"),
7 
-                   callProbability=new("matrix"),
8 
-                   alleleA=new("matrix"),
9 
-                   alleleB=new("matrix"),
10 
-		   featureData,
11 
-		   annotation,
12 
-		   ...){
13 
-		  if(!missing(assayData)){
14 
-			  .Object <- callNextMethod(.Object, assayData=assayData,...)
15 
-		  } else{
16 
-			  ad <- assayDataNew("lockedEnvironment",
17 
-					     call=call,
18 
-					     callProbability=callProbability,
19 
-					     alleleA=alleleA,
20 
-					     alleleB=alleleB)
21 
-			  .Object <- callNextMethod(.Object,
22 
-						    assayData=ad, ...)
23 
-		  }
24 
-		  if(missing(annotation)){
25 
-			  stop("must specify annotation")
26 
-		  } else{
27 
-			  stopifnot(isValidCdfName(annotation))
28 
-			  .Object@annotation <- annotation
29 
-		  }
30 
-		  if (missing(featureData)){
31 
-			  featureData(.Object) <- annotatedDataFrameFrom(call, byrow=TRUE)
32 
-		  } else{
33 
-			  featureData(.Object) <- featureData
34 
-		  }
35 
-		  ## Do after annotation has been assigned
36 
-		  if(!(all(c("chromosome", "position", "isSnp")  %in% colnames(.Object@featureData)))){
37 
-			  ##update the featureData
38 
-			  .Object@featureData <- addFeatureAnnotation.SnpSuperSet(.Object)
39 
-		  }
40 
-		  .Object
41 
-          })
42 139
43 
-setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
44 
-	addFeatureAnnotation.SnpSuperSet(object, ...)
45 
-})
140 
+##setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
141 
+##	addFeatureAnnotation.crlmm(object, ...)
142 
+##})
46 143
47 144 
 getParam.SnpSuperSet <- function(object, name, batch){
48 145 
 		  label <- paste(name, batch, sep="_")
... ... 
@@ -64,49 +161,48 @@ getParam.SnpSuperSet <- function(object, name, batch){
64 161
65 162
66 163
67 
-setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
68 
-	tmpdir <- cnOptions[["tmpdir"]]
69 
-	outdir <- cnOptions[["outdir"]]
70 
-	save.it <- cnOptions[["save.it"]]
71 
-	path <- system.file("extdata", package=paste(annotation(object), "Crlmm", sep=""))
72 
-	load(file.path(path, "snpProbes.rda"))
73 
-	snpProbes <- get("snpProbes")
74 
-	load(file.path(path, "cnProbes.rda"))
75 
-	cnProbes <- get("cnProbes")
76 
-	k <- grep("chr", colnames(snpProbes))
77 
-	if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")
78 
-	for(CHR in 1:24){
79 
-		cat("Chromosome ", CHR, "\n")
80 
-		snps <- rownames(snpProbes)[snpProbes[, k] == CHR]
81 
-		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
82 
-		index <- c(match(snps, featureNames(object)),
83 
-			   match(cnps, featureNames(object)))
84 
-		index <- index[!is.na(index)]
85 
-		callSetPlus <- object[index, ]
86 
-		if(CHR != 24){
87 
-			cnSet <- computeCopynumber(callSetPlus, cnOptions)
88 
-
89 
-		} else{
90 
-			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSetPlus' object for this chromosome")
91 
-			save(callSetPlus, file=file.path(outdir, paste("callSetPlus_", CHR, ".rda", sep="")))
92 
-		}
93 
-		if(cnOptions[["hiddenMarkovModel"]] & CHR != 24){
94 
-			cnSet <- computeHmm(cnSet, cnOptions)
95 
-		}
96 
-		save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
97 
-		saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
98 
-##		} else{ ## save crlmmSet to outdir
99 
-##			save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
100 
-##			saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
101 
-##		}
102 
-	}
103 
-	saved.objects
104 
-})
164 
+##setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
165 
+##	tmpdir <- cnOptions[["tmpdir"]]
166 
+##	outdir <- cnOptions[["outdir"]]
167 
+##	save.it <- cnOptions[["save.it"]]
168 
+##	path <- system.file("extdata", package=paste(annotation(object), "Crlmm", sep=""))
169 
+##	load(file.path(path, "snpProbes.rda"))
170 
+##	snpProbes <- get("snpProbes")
171 
+##	load(file.path(path, "cnProbes.rda"))
172 
+##	cnProbes <- get("cnProbes")
173 
+##	k <- grep("chr", colnames(snpProbes))
174 
+##	if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")
175 
+##	for(CHR in 1:24){
176 
+##		cat("Chromosome ", CHR, "\n")
177 
+##		snps <- rownames(snpProbes)[snpProbes[, k] == CHR]
178 
+##		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
179 
+##		index <- c(match(snps, featureNames(object)),
180 
+##			   match(cnps, featureNames(object)))
181 
+##		index <- index[!is.na(index)]
182 
+##		callSetPlus <- object[index, ]
183 
+##		if(CHR != 24){
184 
+##			cnSet <- computeCopynumber(callSetPlus, cnOptions)
185 
+##
186 
+##		} else{
187 
+##			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSetPlus' object for this chromosome")
188 
+##			save(callSetPlus, file=file.path(outdir, paste("callSetPlus_", CHR, ".rda", sep="")))
189 
+##		}
190 
+##		if(cnOptions[["hiddenMarkovModel"]] & CHR != 24){
191 
+##			cnSet <- computeHmm(cnSet, cnOptions)
192 
+##		}
193 
+##		save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
194 
+##		saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
195 
+####		} else{ ## save crlmmSet to outdir
196 
+####			save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
197 
+####			saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
198 
+####		}
199 
+##	}
200 
+##	saved.objects
201 
+##})
105 202
106 203 
 setMethod("computeCopynumber", "SnpSuperSet",
107 204 
 	  function(object, cnOptions){
108 205 
 		  computeCopynumber.SnpSuperSet(object, cnOptions)
109 206 
 	  })
110 207
111 
-##gtConfidence <- function(object) 1-exp(-confs(object)/1000)
112 208
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
Showing 1 changed files
R/methods-SnpSuperSet.R
History View file @ bc16b51
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,112 @@
1 
+##How to make the initialization platform-specific?
2 
+
3 
+setMethod("initialize", "SnpSuperSet",
4 
+          function(.Object,
5 
+		   assayData,
6 
+                   call=new("matrix"),
7 
+                   callProbability=new("matrix"),
8 
+                   alleleA=new("matrix"),
9 
+                   alleleB=new("matrix"),
10 
+		   featureData,
11 
+		   annotation,
12 
+		   ...){
13 
+		  if(!missing(assayData)){
14 
+			  .Object <- callNextMethod(.Object, assayData=assayData,...)
15 
+		  } else{
16 
+			  ad <- assayDataNew("lockedEnvironment",
17 
+					     call=call,
18 
+					     callProbability=callProbability,
19 
+					     alleleA=alleleA,
20 
+					     alleleB=alleleB)
21 
+			  .Object <- callNextMethod(.Object,
22 
+						    assayData=ad, ...)
23 
+		  }
24 
+		  if(missing(annotation)){
25 
+			  stop("must specify annotation")
26 
+		  } else{
27 
+			  stopifnot(isValidCdfName(annotation))
28 
+			  .Object@annotation <- annotation
29 
+		  }
30 
+		  if (missing(featureData)){
31 
+			  featureData(.Object) <- annotatedDataFrameFrom(call, byrow=TRUE)
32 
+		  } else{
33 
+			  featureData(.Object) <- featureData
34 
+		  }
35 
+		  ## Do after annotation has been assigned
36 
+		  if(!(all(c("chromosome", "position", "isSnp")  %in% colnames(.Object@featureData)))){
37 
+			  ##update the featureData
38 
+			  .Object@featureData <- addFeatureAnnotation.SnpSuperSet(.Object)
39 
+		  }
40 
+		  .Object
41 
+          })
42 
+
43 
+setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
44 
+	addFeatureAnnotation.SnpSuperSet(object, ...)
45 
+})
46 
+
47 
+getParam.SnpSuperSet <- function(object, name, batch){
48 
+		  label <- paste(name, batch, sep="_")
49 
+		  colindex <- grep(label, fvarLabels(object))
50 
+		  if(length(colindex) == 1){
51 
+			  param <- fData(object)[, colindex]
52 
+		  }
53 
+		  if(length(colindex) < 1){
54 
+			  param <- NULL
55 
+		  }
56 
+		  if(is.na(colindex)){
57 
+			  stop(paste(label, " not found in object"))
58 
+		  }
59 
+		  if(length(colindex) > 1){
60 
+			  stop(paste(label, " not unique"))
61 
+		  }
62 
+		  return(param)
63 
+	  }
64 
+
65 
+
66 
+
67 
+setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
68 
+	tmpdir <- cnOptions[["tmpdir"]]
69 
+	outdir <- cnOptions[["outdir"]]
70 
+	save.it <- cnOptions[["save.it"]]
71 
+	path <- system.file("extdata", package=paste(annotation(object), "Crlmm", sep=""))
72 
+	load(file.path(path, "snpProbes.rda"))
73 
+	snpProbes <- get("snpProbes")
74 
+	load(file.path(path, "cnProbes.rda"))
75 
+	cnProbes <- get("cnProbes")
76 
+	k <- grep("chr", colnames(snpProbes))
77 
+	if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")
78 
+	for(CHR in 1:24){
79 
+		cat("Chromosome ", CHR, "\n")
80 
+		snps <- rownames(snpProbes)[snpProbes[, k] == CHR]
81 
+		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
82 
+		index <- c(match(snps, featureNames(object)),
83 
+			   match(cnps, featureNames(object)))
84 
+		index <- index[!is.na(index)]
85 
+		callSetPlus <- object[index, ]
86 
+		if(CHR != 24){
87 
+			cnSet <- computeCopynumber(callSetPlus, cnOptions)
88 
+
89 
+		} else{
90 
+			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSetPlus' object for this chromosome")
91 
+			save(callSetPlus, file=file.path(outdir, paste("callSetPlus_", CHR, ".rda", sep="")))
92 
+		}
93 
+		if(cnOptions[["hiddenMarkovModel"]] & CHR != 24){
94 
+			cnSet <- computeHmm(cnSet, cnOptions)
95 
+		}
96 
+		save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
97 
+		saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
98 
+##		} else{ ## save crlmmSet to outdir
99 
+##			save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
100 
+##			saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
101 
+##		}
102 
+	}
103 
+	saved.objects
104 
+})
105 
+
106 
+setMethod("computeCopynumber", "SnpSuperSet",
107 
+	  function(object, cnOptions){
108 
+		  computeCopynumber.SnpSuperSet(object, cnOptions)
109 
+	  })
110 
+
111 
+##gtConfidence <- function(object) 1-exp(-confs(object)/1000)
112 
+