1. crlmm
  2. R
  3. methods-CrlmmSetList.R
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
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ bf8acd0
1 1 
deleted file mode 100644
... ... 
@@ -1,317 +0,0 @@
1 
-setMethod("[", "CrlmmSetList", function(x, i, j, ..., drop = FALSE){
2 
-            if (missing(drop)) drop <- FALSE
3 
-            if (missing(i) && missing(j))
4 
-              {
5 
-                 if (length(list(...))!=0)
6 
-                   stop("specify genes or samples to subset; use '",
7 
-                        substitute(x), "$", names(list(...))[[1]],
8 
-                        "' to access phenoData variables")
9 
-                 return(x)
10 
-               }
11 
-            if (!missing(j)){
12 
-              f1 <- function(x, j){
13 
-                x <- x[, j]
14 
-              }
15 
-              x <- lapply(x, f1, j)
16 
-            }
17 
-            if(!missing(i)){
18 
-              f2 <- function(x, i){
19 
-                x <- x[i, ]
20 
-              }
21 
-              x <- lapply(x, f2, i)
22 
-            }
23 
-	as(x, "CrlmmSetList")
24 
-})
25 
-
26 
-setMethod("$", "CrlmmSetList", function(x, name) {
27 
-	##if(!(name %in% .parameterNames()[output(x) != 0])){
28 
-	if(length(x) != 3){
29 
-		stop("'$' operature reserved for accessing parameter names in CopyNumberSet object.  CrlmmSetList must be of length 3")
30 
-	}
31 
-	j <- grep(name, fvarLabels(x[[3]]))
32 
-	if(length(j) < 1)
33 
-		stop(name, " not in fvarLabels of CopyNumberSet object")
34 
-	if(length(j) > 1){
35 
-		warning("Multiple instances of ", name, " in fvarLabels.  Using the first instance")
36 
-		j <- j[1]
37 
-	}
38 
-	param <- fData(x[[3]])[, j]
39 
-	param
40 
-})
41 
-setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
42 
-	i <- length(object)
43 
-	while(i > 1){
44 
-		object[[i-1]] <- harmonizeDimnamesTo(object[[i-1]], object[[i]])
45 
-		i <- i-1
46 
-	}
47 
-	object
48 
-})
49 
-
50 
-setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
51 
-
52 
-setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, ...){
53 
-	##if(missing(CHR)) stop("Must specificy chromosome")
54 
-	cdfName <- annotation(object)
55 
-	pkgname <- paste(cdfName, "Crlmm", sep="")
56 
-	path <- system.file("extdata", package=pkgname)
57 
-	loader("cnProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
58 
-	cnProbes <- get("cnProbes", envir=.crlmmPkgEnv)
59 
-	loader("snpProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
60 
-	snpProbes <- get("snpProbes", envir=.crlmmPkgEnv)
61 
-
62 
-	##Feature Data
63 
-	snps <- featureNames(object)[snpIndex(object)]
64 
-	nps <- featureNames(object)[cnIndex(object)]
65 
-	position.snp <- snpProbes[match(snps, rownames(snpProbes)), "position"]
66 
-	names(position.snp) <- snps
67 
-	position.np <- cnProbes[match(nps, rownames(cnProbes)), "position"]
68 
-	names(position.np) <- nps
69 
-
70 
-	J <- grep("chr", colnames(snpProbes))
71 
-	chr.snp <- snpProbes[match(snps, rownames(snpProbes)), J]
72 
-	chr.np <- cnProbes[match(nps, rownames(cnProbes)), J]
73 
-
74 
-	position <- c(position.snp, position.np)
75 
-	chrom <- c(chr.snp, chr.np)
76 
-
77 
-	##We may not have annotation for all of the snps
78 
-	if(!all(featureNames(object) %in% names(position))){
79 
-		message("Dropping loci for which physical position  is not available.")
80 
-		object <- object[featureNames(object) %in% names(position), ]
81 
-	}
82 
-	ix <- match(featureNames(object), names(position))
83 
-	position <- position[ix]
84 
-	chrom <- chrom[ix]
85 
-	##require(SNPchip)
86 
-	chrom <- chromosome2integer(chrom)
87 
-
88 
-	stopifnot(identical(names(position), featureNames(object)))
89 
-	if(sum(duplicated(names(position))) > 0){
90 
-		warning("Removing rows with NA identifiers...")
91 
-		##RS: fix this
92 
-		I <- which(!is.na(names(position)))
93 
-	}  else I <- seq(along=names(position))
94 
-	fd <- data.frame(cbind(chrom[I],
95 
-			       position[I]))
96 
-	colnames(fd) <- c("chromosome", "position")
97 
-	rownames(fd) <- featureNames(object)
98 
-	fD <- new("AnnotatedDataFrame",
99 
-		  data=fd,
100 
-		  varMetadata=data.frame(labelDescription=colnames(fd)))
101 
-	return(fD)
102 
-})
103 
-
104 
-setMethod("annotation", "CrlmmSetList", function(object) annotation(object[[1]]))
105 
-setMethod("B", "CrlmmSetList", function(object) B(object[[1]]))
106 
-setMethod("batch", "CrlmmSetList", function(object) batch(object[[3]]))
107 
-setMethod("CA", "CrlmmSetList", function(object, ...) CA(object[[3]], ...))
108 
-setMethod("CB", "CrlmmSetList", function(object, ...) CB(object[[3]], ...))
109 
-setMethod("calls", "CrlmmSetList", function(object) calls(object[[2]]))
110 
-setMethod("chromosome", "CrlmmSetList", function(object){
111 
-	chr <- NULL
112 
-	for(i  in 1:length(object)){
113 
-		if(length(fvarLabels(object[[i]])) > 0){
114 
-			if("chromosome" %in% fvarLabels(object[[i]])){
115 
-				chr <- chromosome(object[[i]])
116 
-				break()
117 
-			}
118 
-		}
119 
-	}
120 
-	if(is.null(chr)) warning("fvarLabel 'chromosome' not in any element of the CrlmmSetList object")
121 
-	return(chr)
122 
-	##chromosome(object[[3]])
123 
-	})
124 
-
125 
-setMethod("position", "CrlmmSetList", function(object){
126 
-	pos <- NULL
127 
-	for(i  in 1:length(object)){
128 
-		if(length(fvarLabels(object[[i]])) > 0){
129 
-			if("position" %in% fvarLabels(object[[i]])){
130 
-				pos <- position(object[[i]])
131 
-				break()
132 
-			}
133 
-		} else next()
134 
-	}
135 
-	if(is.null(pos)) warning("fvarLabel 'position' not in any element of the CrlmmSetList object")
136 
-	return(pos)
137 
-	})
138 
-
139 
-setMethod("cnIndex", "CrlmmSetList", function(object, ...) {
140 
-	match(cnNames(object[[1]], annotation(object)), featureNames(object))
141 
-})
142 
-setMethod("combine", signature=signature(x="CrlmmSetList", y="CrlmmSetList"),
143 
-          function(x, y, ...){
144 
-		  x.abset <- x[[1]]
145 
-		  y.abset <- y[[1]]
146 
-		  x.snpset <- x[[2]]
147 
-		  y.snpset <- y[[2]]
148 
-		  abset <- combine(x.abset, y.abset)
149 
-		  ##we have hijacked the featureData slot to store parameters.  Biobase will not allow combining our 'feature' data.
150 
-		  warning("the featureData is not easily combined...  removing the featureData")
151 
-		  ##fd1 <- featureData(x.snpset)
152 
-		  ##fd2 <- featureData(y.snpset)
153 
-		  featureData(x.snpset) <- annotatedDataFrameFrom(calls(x.snpset), byrow=TRUE)
154 
-		  featureData(y.snpset) <- annotatedDataFrameFrom(calls(y.snpset), byrow=TRUE)
155 
-		  snpset <- combine(x.snpset, y.snpset)
156 
-		  merged <- list(abset, snpset)
157 
-		  merged <- as(merged, "CrlmmSetList")
158 
-		  merged
159 
-	  })
160 
-setMethod("confs", "CrlmmSetList", function(object) confs(object[[2]]))
161 
-setMethod("copyNumber", "CrlmmSetList", function(object) copyNumber(object[[3]]))
162 
-setMethod("dims", "CrlmmSetList", function(object) sapply(object, dim))
163 
-setMethod("featureNames", "CrlmmSetList", function(object) featureNames(object[[1]]))
164 
-setMethod("ncol", signature(x="CrlmmSetList"), function(x) ncol(x[[1]]))
165 
-setMethod("nrow", signature(x="CrlmmSetList"), function(x) nrow(x[[1]]))
166 
-setMethod("plot", signature(x="CrlmmSetList"),
167 
-	  function(x, y, ...){
168 
-		  A <- log2(A(x))
169 
-		  B <- log2(B(x))
170 
-		  plot(A, B, ...)
171 
-	  })
172 
-setMethod("points", signature(x="CrlmmSetList"),
173 
-	  function(x, y, ...){
174 
-		  A <- log2(A(x))
175 
-		  B <- log2(B(x))
176 
-		  points(A, B, ...)
177 
-	  })
178 
-setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
179 
-setMethod("show", "CrlmmSetList", function(object){
180 
-	cat("\n Elements in CrlmmSetList object: \n")
181 
-	cat("\n")
182 
-	for(i in 1:length(object)){
183 
-		cat("class: ", class(object[[i]]), "\n")
184 
-		cat("assayData elements: ", ls(assayData(object[[i]])), "\n")
185 
-		cat("Dimensions: ", dim(object[[i]]))
186 
-		cat("\n \n")
187 
-	}
188 
-})
189 
-setMethod("snpIndex", "CrlmmSetList", function(object, ...){
190 
-	match(snpNames(object[[1]], annotation(object)), featureNames(object))
191 
-})
192 
-setMethod("splitByChromosome", "CrlmmSetList", function(object, cdfName, outdir){
193 
-	path <- system.file("extdata", package=paste(cdfName, "Crlmm", sep=""))
194 
-	load(file.path(path, "snpProbes.rda"))
195 
-	load(file.path(path, "cnProbes.rda"))
196 
-	k <- grep("chr", colnames(snpProbes))
197 
-	if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")
198 
-	for(CHR in 1:24){
199 
-		cat("Chromosome ", CHR, "\n")
200 
-		snps <- rownames(snpProbes)[snpProbes[, k] == CHR]
201 
-		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
202 
-		index <- c(match(snps, featureNames(object)),
203 
-			   match(cnps, featureNames(object)))
204 
-		index <- index[!is.na(index)]
205 
-		crlmmSetList <- object[index, ]
206 
-		save(crlmmSetList, file=file.path(outdir, paste("crlmmSetList_", CHR, ".rda", sep="")))
207 
-	}
208 
-})
209 
-
210 
-setMethod("update", "CrlmmSetList", function(object, ...){
211 
-	if(length(crlmmSetList) == 3){
212 
-		message("copy number object already present. Nothing to do.")
213 
-		return()
214 
-	}
215 
-	CHR <- unique(chromosome(crlmmSetList[[1]]))
216 
-	if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")
217 
-	if(CHR == 24){
218 
-		message("A solution for chromosome 24 is not yet available.")
219 
-		return()
220 
-	}
221 
-	computeCopynumber(object, CHR=CHR, ...)
222 
-})
223 
-
224 
-setReplaceMethod("CA", signature(object="CrlmmSetList", value="matrix"),
225 
-		 function(object, value){
226 
-			 CA(object[[3]]) <- value
227 
-			 object
228 
-		 })
229 
-setReplaceMethod("CB", signature(object="CrlmmSetList", value="matrix"),
230 
-		 function(object, value){
231 
-			 CB(object[[3]]) <- value
232 
-			 object
233 
-			 })
234 
-
235 
-setReplaceMethod("A", signature(object="CrlmmSetList", value="matrix"),
236 
-		 function(object, value){
237 
-			 A(object[[1]]) <- value
238 
-			 object
239 
-		 })
240 
-setReplaceMethod("B", signature(object="CrlmmSetList", value="matrix"),
241 
-		 function(object, value){
242 
-			 B(object[[1]]) <- value
243 
-			 object
244 
-		 })
245 
-
246 
-
247 
-
248 
-setMethod("boxplot", "CrlmmSetList", function(x, ...){
249 
-##boxplot.CrlmmSetList <- function(x, ...){
250 
-	if(length(x) != 3) stop("elements of list should be of class ABset, SnpSet, and CopyNumberSet, respectively.")
251 
-	genotypes <- calls(x)-1
252 
-	A1 <- A(x)
253 
-	B1 <- B(x)
254 
-	Alist <- split(A1, genotypes)
255 
-	Alist <- as(rev(Alist), "data.frame")
256 
-	Blist <- split(B1, genotypes)
257 
-	ylim <- range(unlist(Alist))
258 
-	boxplot(Alist, xaxt="n", ylab=expression(I[A]),
259 
-		cex.axis=0.6,
260 
-		xlab="",
261 
-		ylim=range(unlist(Alist), na.rm=TRUE),
262 
-		border="grey50", xaxs="i", at=0:2, xlim=c(-0.5, 2.5),
263 
-		cex.main=0.9, xaxt="n",
264 
-		yaxt="n",
265 
-		col=cols)
266 
-	axis(2, at=pretty(ylim), cex.axis=0.8)
267 
-	axis(1, at=0:2, labels=rev(c("2A (AA genotype)", "1A (AB genotype)", "0A (BB genotype)")), cex.axis=0.7)
268 
-	##extracts nuA for first batch
269 
-	suppressWarnings(nuA <- x$nuA)
270 
-	segments(-1, nuA,
271 
-		 0, nuA, lty=2, col="blue")
272 
-	suppressWarnings(phiA <- x$phiA)
273 
-	##phiA <- fData(x)[["phiA_A"]]
274 
-	segments(0, nuA,
275 
-		 2.5, nuA+2.5*phiA, lwd=2, col="blue")
276 
-	axis(2, at=nuA, labels=expression(hat(nu[A])), cex.axis=0.9)
277 
-	text(0, ylim[1], labels=paste("n =", length(Alist[[1]])), cex=0.8)
278 
-	text(1, ylim[1], labels=paste("n =", length(Alist[[2]])), cex=0.8)
279 
-	text(2, ylim[1], labels=paste("n =", length(Alist[[3]])), cex=0.8)
280 
-##	segments(0.5, nuA+0.5*phiA,
281 
-##		 1, pretty(ylim, n=5)[2], lty=2, col="blue")
282 
-##	segments(1, pretty(ylim, n=5)[2],
283 
-##		 1.2, pretty(ylim)[2], lty=2, col="blue")
284 
-##	text(1.25, pretty(ylim)[2], pos=4,
285 
-##	     labels=expression(hat(nu[A]) + c[A]*hat(phi[A])))
286 
-	legend("topleft", fill=rev(cols), legend=c("AA", "AB", "BB"))##, title="diallelic genotypes")
287 
-
288 
-	ylim <- range(unlist(Blist))
289 
-	boxplot(Blist, xaxt="n", ylab=expression(I[B]),
290 
-		##xlab="diallelic genotypes",
291 
-		cex.axis=0.6,
292 
-		ylim=range(unlist(Blist), na.rm=TRUE),
293 
-		border="grey50", xaxs="i",
294 
-		at=0:2, xlim=c(-0.5, 2.5),
295 
-		cex.main=0.9, yaxt="n",
296 
-		col=rev(cols))
297 
-	axis(2, at=pretty(ylim), cex.axis=0.8)
298 
-	axis(1, at=0:2, labels=c("0B (AA genotype)", "1B (AB genotype)", "2B (BB genotype)"), cex.axis=0.7)
299 
-	##nuB <- fData(x)[["nuB_A"]]
300 
-	suppressWarnings(nuB <- x$nuB)
301 
-	segments(-1, nuB,
302 
-		 0, nuB, lty=2, col="blue")
303 
-	##phiB <- fData(x[i,])[["phiB_A"]]
304 
-	suppressWarnings(phiB <- x$phiB)
305 
-	segments(0, nuB,
306 
-		 2.5, nuB+2.5*phiB, lwd=2, col="blue")
307 
-	axis(2, at=nuB, labels=expression(hat(nu[B])), cex.axis=0.9)
308 
-	text(0, ylim[1], labels=paste("n =", length(Blist[[1]])), cex=0.8)
309 
-	text(1, ylim[1], labels=paste("n =", length(Blist[[2]])), cex=0.8)
310 
-	text(2, ylim[1], labels=paste("n =", length(Blist[[3]])), cex=0.8)
311 
-##	segments(0.5, nuB+0.5*phiB,
312 
-##		 1, pretty(ylim,n=5)[2], lty=2, col="blue")
313 
-##	segments(1, pretty(ylim, n=5)[2],
314 
-##		 1.2, pretty(ylim,n=5)[2], lty=2, col="blue")
315 
-##	text(1.25, pretty(ylim,n=5)[2], pos=4, labels=expression(hat(nu[B]) + c[B]*hat(phi[B])))
316 
-	mtext(featureNames(x)[i], 3, outer=TRUE, line=1)
317 
-})
Browse code

updated vignettes for illumina and affy

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

Rob Scharp authored on 16/10/2009 12:08:21
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ 3ddde61
... ... 
@@ -73,6 +73,12 @@ setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, ...){
73 73
74 74 
 	position <- c(position.snp, position.np)
75 75 
 	chrom <- c(chr.snp, chr.np)
76 
+
77 
+	##We may not have annotation for all of the snps
78 
+	if(!all(featureNames(object) %in% names(position))){
79 
+		message("Dropping loci for which physical position  is not available.")
80 
+		object <- object[featureNames(object) %in% names(position), ]
81 
+	}
76 82 
 	ix <- match(featureNames(object), names(position))
77 83 
 	position <- position[ix]
78 84 
 	chrom <- chrom[ix]
... ... 
@@ -200,8 +206,19 @@ setMethod("splitByChromosome", "CrlmmSetList", function(object, cdfName, outdir)
200 206 
 		save(crlmmSetList, file=file.path(outdir, paste("crlmmSetList_", CHR, ".rda", sep="")))
201 207 
 	}
202 208 
 })
209 
+
203 210 
 setMethod("update", "CrlmmSetList", function(object, ...){
204 
-	computeCopynumber(object, ...)
211 
+	if(length(crlmmSetList) == 3){
212 
+		message("copy number object already present. Nothing to do.")
213 
+		return()
214 
+	}
215 
+	CHR <- unique(chromosome(crlmmSetList[[1]]))
216 
+	if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")
217 
+	if(CHR == 24){
218 
+		message("A solution for chromosome 24 is not yet available.")
219 
+		return()
220 
+	}
221 
+	computeCopynumber(object, CHR=CHR, ...)
205 222 
 })
206 223
207 224 
 setReplaceMethod("CA", signature(object="CrlmmSetList", value="matrix"),
Browse code

bug fixes

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

Rob Scharp authored on 09/10/2009 12:47:42
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ e4e0b21
... ... 
@@ -49,8 +49,8 @@ setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
49 49
50 50 
 setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
51 51
52 
-setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, CHR){
53 
-	if(missing(CHR)) stop("Must specificy chromosome")
52 
+setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, ...){
53 
+	##if(missing(CHR)) stop("Must specificy chromosome")
54 54 
 	cdfName <- annotation(object)
55 55 
 	pkgname <- paste(cdfName, "Crlmm", sep="")
56 56 
 	path <- system.file("extdata", package=pkgname)
... ... 
@@ -66,16 +66,26 @@ setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, CHR){
66 66 
 	names(position.snp) <- snps
67 67 
 	position.np <- cnProbes[match(nps, rownames(cnProbes)), "position"]
68 68 
 	names(position.np) <- nps
69 
+
70 
+	J <- grep("chr", colnames(snpProbes))
71 
+	chr.snp <- snpProbes[match(snps, rownames(snpProbes)), J]
72 
+	chr.np <- cnProbes[match(nps, rownames(cnProbes)), J]
69 73
70 74 
 	position <- c(position.snp, position.np)
71 
-	position <- position[match(featureNames(object), names(position))]
75 
+	chrom <- c(chr.snp, chr.np)
76 
+	ix <- match(featureNames(object), names(position))
77 
+	position <- position[ix]
78 
+	chrom <- chrom[ix]
79 
+	##require(SNPchip)
80 
+	chrom <- chromosome2integer(chrom)
81 
+
72 82 
 	stopifnot(identical(names(position), featureNames(object)))
73 83 
 	if(sum(duplicated(names(position))) > 0){
74 84 
 		warning("Removing rows with NA identifiers...")
75 85 
 		##RS: fix this
76 86 
 		I <- which(!is.na(names(position)))
77 87 
 	}  else I <- seq(along=names(position))
78 
-	fd <- data.frame(cbind(CHR,
88 
+	fd <- data.frame(cbind(chrom[I],
79 89 
 			       position[I]))
80 90 
 	colnames(fd) <- c("chromosome", "position")
81 91 
 	rownames(fd) <- featureNames(object)
Browse code

changes to crlmmWrapper. updated vignettes in inst/scripts.

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

Rob Scharp authored on 04/10/2009 02:37:32
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ 2ae7850
... ... 
@@ -48,13 +48,78 @@ setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
48 48 
 })
49 49
50 50 
 setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
51 
+
52 
+setMethod("addFeatureAnnotation", "CrlmmSetList", function(object, CHR){
53 
+	if(missing(CHR)) stop("Must specificy chromosome")
54 
+	cdfName <- annotation(object)
55 
+	pkgname <- paste(cdfName, "Crlmm", sep="")
56 
+	path <- system.file("extdata", package=pkgname)
57 
+	loader("cnProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
58 
+	cnProbes <- get("cnProbes", envir=.crlmmPkgEnv)
59 
+	loader("snpProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
60 
+	snpProbes <- get("snpProbes", envir=.crlmmPkgEnv)
61 
+
62 
+	##Feature Data
63 
+	snps <- featureNames(object)[snpIndex(object)]
64 
+	nps <- featureNames(object)[cnIndex(object)]
65 
+	position.snp <- snpProbes[match(snps, rownames(snpProbes)), "position"]
66 
+	names(position.snp) <- snps
67 
+	position.np <- cnProbes[match(nps, rownames(cnProbes)), "position"]
68 
+	names(position.np) <- nps
69 
+
70 
+	position <- c(position.snp, position.np)
71 
+	position <- position[match(featureNames(object), names(position))]
72 
+	stopifnot(identical(names(position), featureNames(object)))
73 
+	if(sum(duplicated(names(position))) > 0){
74 
+		warning("Removing rows with NA identifiers...")
75 
+		##RS: fix this
76 
+		I <- which(!is.na(names(position)))
77 
+	}  else I <- seq(along=names(position))
78 
+	fd <- data.frame(cbind(CHR,
79 
+			       position[I]))
80 
+	colnames(fd) <- c("chromosome", "position")
81 
+	rownames(fd) <- featureNames(object)
82 
+	fD <- new("AnnotatedDataFrame",
83 
+		  data=fd,
84 
+		  varMetadata=data.frame(labelDescription=colnames(fd)))
85 
+	return(fD)
86 
+})
87 
+
51 88 
 setMethod("annotation", "CrlmmSetList", function(object) annotation(object[[1]]))
52 89 
 setMethod("B", "CrlmmSetList", function(object) B(object[[1]]))
53 90 
 setMethod("batch", "CrlmmSetList", function(object) batch(object[[3]]))
54 91 
 setMethod("CA", "CrlmmSetList", function(object, ...) CA(object[[3]], ...))
55 92 
 setMethod("CB", "CrlmmSetList", function(object, ...) CB(object[[3]], ...))
56 93 
 setMethod("calls", "CrlmmSetList", function(object) calls(object[[2]]))
57 
-setMethod("chromosome", "CrlmmSetList", function(object) chromosome(object[[3]]))
94 
+setMethod("chromosome", "CrlmmSetList", function(object){
95 
+	chr <- NULL
96 
+	for(i  in 1:length(object)){
97 
+		if(length(fvarLabels(object[[i]])) > 0){
98 
+			if("chromosome" %in% fvarLabels(object[[i]])){
99 
+				chr <- chromosome(object[[i]])
100 
+				break()
101 
+			}
102 
+		}
103 
+	}
104 
+	if(is.null(chr)) warning("fvarLabel 'chromosome' not in any element of the CrlmmSetList object")
105 
+	return(chr)
106 
+	##chromosome(object[[3]])
107 
+	})
108 
+
109 
+setMethod("position", "CrlmmSetList", function(object){
110 
+	pos <- NULL
111 
+	for(i  in 1:length(object)){
112 
+		if(length(fvarLabels(object[[i]])) > 0){
113 
+			if("position" %in% fvarLabels(object[[i]])){
114 
+				pos <- position(object[[i]])
115 
+				break()
116 
+			}
117 
+		} else next()
118 
+	}
119 
+	if(is.null(pos)) warning("fvarLabel 'position' not in any element of the CrlmmSetList object")
120 
+	return(pos)
121 
+	})
122 
+
58 123 
 setMethod("cnIndex", "CrlmmSetList", function(object, ...) {
59 124 
 	match(cnNames(object[[1]], annotation(object)), featureNames(object))
60 125 
 })
... ... 
@@ -94,7 +159,6 @@ setMethod("points", signature(x="CrlmmSetList"),
94 159 
 		  B <- log2(B(x))
95 160 
 		  points(A, B, ...)
96 161 
 	  })
97 
-setMethod("position", "CrlmmSetList", function(object) position(object[[3]]))
98 162 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
99 163 
 setMethod("show", "CrlmmSetList", function(object){
100 164 
 	cat("\n Elements in CrlmmSetList object: \n")
... ... 
@@ -130,6 +194,29 @@ setMethod("update", "CrlmmSetList", function(object, ...){
130 194 
 	computeCopynumber(object, ...)
131 195 
 })
132 196
197 
+setReplaceMethod("CA", signature(object="CrlmmSetList", value="matrix"),
198 
+		 function(object, value){
199 
+			 CA(object[[3]]) <- value
200 
+			 object
201 
+		 })
202 
+setReplaceMethod("CB", signature(object="CrlmmSetList", value="matrix"),
203 
+		 function(object, value){
204 
+			 CB(object[[3]]) <- value
205 
+			 object
206 
+			 })
207 
+
208 
+setReplaceMethod("A", signature(object="CrlmmSetList", value="matrix"),
209 
+		 function(object, value){
210 
+			 A(object[[1]]) <- value
211 
+			 object
212 
+		 })
213 
+setReplaceMethod("B", signature(object="CrlmmSetList", value="matrix"),
214 
+		 function(object, value){
215 
+			 B(object[[1]]) <- value
216 
+			 object
217 
+		 })
218 
+
219 
+
133 220
134 221 
 setMethod("boxplot", "CrlmmSetList", function(x, ...){
135 222 
 ##boxplot.CrlmmSetList <- function(x, ...){
... ... 
@@ -138,7 +225,7 @@ setMethod("boxplot", "CrlmmSetList", function(x, ...){
138 225 
 	A1 <- A(x)
139 226 
 	B1 <- B(x)
140 227 
 	Alist <- split(A1, genotypes)
141 
-	Alist <- rev(Alist)
228 
+	Alist <- as(rev(Alist), "data.frame")
142 229 
 	Blist <- split(B1, genotypes)
143 230 
 	ylim <- range(unlist(Alist))
144 231 
 	boxplot(Alist, xaxt="n", ylab=expression(I[A]),
Browse code

changes to vignette. removed crlmmIlluminaWrapper function. added boxplot method

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

Rob Scharp authored on 14/08/2009 14:14:25
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ bd722b7
... ... 
@@ -23,43 +23,48 @@ setMethod("[", "CrlmmSetList", function(x, i, j, ..., drop = FALSE){
23 23 
 	as(x, "CrlmmSetList")
24 24 
 })
25 25
26 
-##setReplaceMethod("[[", "CrlmmSetList", function(x, i, j, ..., value) {
27 
-##	browser()
28 
-##	##otherwise infinite recursion
29 
-##	x <- as(x, "list")
30 
-##	x[[i]] <- value
31 
-##	x <- as(x, "CrlmmSetList")
32 
-##	x <- .harmonizeDimnames(x)
33 
-##	stopifnot(identical(featureNames(x[[i]]), featureNames(x[[1]])))
34 
-##	return(x)
35 
-##})
26 
+setMethod("$", "CrlmmSetList", function(x, name) {
27 
+	##if(!(name %in% .parameterNames()[output(x) != 0])){
28 
+	if(length(x) != 3){
29 
+		stop("'$' operature reserved for accessing parameter names in CopyNumberSet object.  CrlmmSetList must be of length 3")
30 
+	}
31 
+	j <- grep(name, fvarLabels(x[[3]]))
32 
+	if(length(j) < 1)
33 
+		stop(name, " not in fvarLabels of CopyNumberSet object")
34 
+	if(length(j) > 1){
35 
+		warning("Multiple instances of ", name, " in fvarLabels.  Using the first instance")
36 
+		j <- j[1]
37 
+	}
38 
+	param <- fData(x[[3]])[, j]
39 
+	param
40 
+})
41 
+setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
42 
+	i <- length(object)
43 
+	while(i > 1){
44 
+		object[[i-1]] <- harmonizeDimnamesTo(object[[i-1]], object[[i]])
45 
+		i <- i-1
46 
+	}
47 
+	object
48 
+})
36 49
37 50 
 setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
38 
-
39 51 
 setMethod("annotation", "CrlmmSetList", function(object) annotation(object[[1]]))
40 
-
41 52 
 setMethod("B", "CrlmmSetList", function(object) B(object[[1]]))
42 
-
53 
+setMethod("batch", "CrlmmSetList", function(object) batch(object[[3]]))
43 54 
 setMethod("CA", "CrlmmSetList", function(object, ...) CA(object[[3]], ...))
44 55 
 setMethod("CB", "CrlmmSetList", function(object, ...) CB(object[[3]], ...))
45 
-
46 56 
 setMethod("calls", "CrlmmSetList", function(object) calls(object[[2]]))
57 
+setMethod("chromosome", "CrlmmSetList", function(object) chromosome(object[[3]]))
47 58 
 setMethod("cnIndex", "CrlmmSetList", function(object, ...) {
48 59 
 	match(cnNames(object[[1]], annotation(object)), featureNames(object))
49 60 
 })
50 
-
51 
-setMethod("copyNumber", "CrlmmSetList", function(object) copyNumber(object[[3]]))
52 
-
53 61 
 setMethod("combine", signature=signature(x="CrlmmSetList", y="CrlmmSetList"),
54 62 
           function(x, y, ...){
55 63 
 		  x.abset <- x[[1]]
56 64 
 		  y.abset <- y[[1]]
57 
-
58 65 
 		  x.snpset <- x[[2]]
59 66 
 		  y.snpset <- y[[2]]
60 
-
61 67 
 		  abset <- combine(x.abset, y.abset)
62 
-
63 68 
 		  ##we have hijacked the featureData slot to store parameters.  Biobase will not allow combining our 'feature' data.
64 69 
 		  warning("the featureData is not easily combined...  removing the featureData")
65 70 
 		  ##fd1 <- featureData(x.snpset)
... ... 
@@ -71,13 +76,10 @@ setMethod("combine", signature=signature(x="CrlmmSetList", y="CrlmmSetList"),
71 76 
 		  merged <- as(merged, "CrlmmSetList")
72 77 
 		  merged
73 78 
 	  })
74 
-
75 
-
76 
-
77 
-##setMethod("fData", "CrlmmSetList", function(object) featureNames(object[[1]]))
78 
-
79 
+setMethod("confs", "CrlmmSetList", function(object) confs(object[[2]]))
80 
+setMethod("copyNumber", "CrlmmSetList", function(object) copyNumber(object[[3]]))
81 
+setMethod("dims", "CrlmmSetList", function(object) sapply(object, dim))
79 82 
 setMethod("featureNames", "CrlmmSetList", function(object) featureNames(object[[1]]))
80 
-
81 83 
 setMethod("ncol", signature(x="CrlmmSetList"), function(x) ncol(x[[1]]))
82 84 
 setMethod("nrow", signature(x="CrlmmSetList"), function(x) nrow(x[[1]]))
83 85 
 setMethod("plot", signature(x="CrlmmSetList"),
... ... 
@@ -86,18 +88,15 @@ setMethod("plot", signature(x="CrlmmSetList"),
86 88 
 		  B <- log2(B(x))
87 89 
 		  plot(A, B, ...)
88 90 
 	  })
89 
-
90 91 
 setMethod("points", signature(x="CrlmmSetList"),
91 92 
 	  function(x, y, ...){
92 93 
 		  A <- log2(A(x))
93 94 
 		  B <- log2(B(x))
94 95 
 		  points(A, B, ...)
95 96 
 	  })
96 
-
97 
+setMethod("position", "CrlmmSetList", function(object) position(object[[3]]))
97 98 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
98 
-
99 99 
 setMethod("show", "CrlmmSetList", function(object){
100 
-	##for(i in seq(along=object)) show(object[[i]])
101 100 
 	cat("\n Elements in CrlmmSetList object: \n")
102 101 
 	cat("\n")
103 102 
 	for(i in 1:length(object)){
... ... 
@@ -106,43 +105,7 @@ setMethod("show", "CrlmmSetList", function(object){
106 105 
 		cat("Dimensions: ", dim(object[[i]]))
107 106 
 		cat("\n \n")
108 107 
 	}
109 
-##	cat("\n")
110 
-##	cat("Dimensions:\n")
111 
-##	print(dims(object))
112 
-})
113 
-
114 
-setMethod("chromosome", "CrlmmSetList", function(object) chromosome(object[[3]]))
115 
-setMethod("position", "CrlmmSetList", function(object) position(object[[3]]))
116 
-setMethod("confs", "CrlmmSetList", function(object) confs(object[[2]]))
117 
-
118 
-
119 
-setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
120 
-	i <- length(object)
121 
-	while(i > 1){
122 
-		object[[i-1]] <- harmonizeDimnamesTo(object[[i-1]], object[[i]])
123 
-		i <- i-1
124 
-	}
125 
-	object
126 
-})
127 
-setMethod("dims", "CrlmmSetList", function(object) sapply(object, dim))
128 
-setMethod("batch", "CrlmmSetList", function(object) batch(object[[3]]))
129 
-setMethod("$", "CrlmmSetList", function(x, name) {
130 
-	##if(!(name %in% .parameterNames()[output(x) != 0])){
131 
-	if(length(x) != 3){
132 
-		stop("'$' operature reserved for accessing parameter names in CopyNumberSet object.  CrlmmSetList must be of length 3")
133 
-	}
134 
-	j <- grep(name, fvarLabels(x[[3]]))
135 
-	if(length(j) < 1)
136 
-		stop(name, " not in fvarLabels of CopyNumberSet object")
137 
-	if(length(j) > 1){
138 
-		warning("Multiple instances of ", name, " in fvarLabels.  Using the first instance")
139 
-		j <- j[1]
140 
-	}
141 
-	param <- fData(x[[3]])[, j]
142 
-	param
143 108 
 })
144 
-
145 
-
146 109 
 setMethod("snpIndex", "CrlmmSetList", function(object, ...){
147 110 
 	match(snpNames(object[[1]], annotation(object)), featureNames(object))
148 111 
 })
... ... 
@@ -163,5 +126,78 @@ setMethod("splitByChromosome", "CrlmmSetList", function(object, cdfName, outdir)
163 126 
 		save(crlmmSetList, file=file.path(outdir, paste("crlmmSetList_", CHR, ".rda", sep="")))
164 127 
 	}
165 128 
 })
129 
+setMethod("update", "CrlmmSetList", function(object, ...){
130 
+	computeCopynumber(object, ...)
131 
+})
166 132
167 133
134 
+setMethod("boxplot", "CrlmmSetList", function(x, ...){
135 
+##boxplot.CrlmmSetList <- function(x, ...){
136 
+	if(length(x) != 3) stop("elements of list should be of class ABset, SnpSet, and CopyNumberSet, respectively.")
137 
+	genotypes <- calls(x)-1
138 
+	A1 <- A(x)
139 
+	B1 <- B(x)
140 
+	Alist <- split(A1, genotypes)
141 
+	Alist <- rev(Alist)
142 
+	Blist <- split(B1, genotypes)
143 
+	ylim <- range(unlist(Alist))
144 
+	boxplot(Alist, xaxt="n", ylab=expression(I[A]),
145 
+		cex.axis=0.6,
146 
+		xlab="",
147 
+		ylim=range(unlist(Alist), na.rm=TRUE),
148 
+		border="grey50", xaxs="i", at=0:2, xlim=c(-0.5, 2.5),
149 
+		cex.main=0.9, xaxt="n",
150 
+		yaxt="n",
151 
+		col=cols)
152 
+	axis(2, at=pretty(ylim), cex.axis=0.8)
153 
+	axis(1, at=0:2, labels=rev(c("2A (AA genotype)", "1A (AB genotype)", "0A (BB genotype)")), cex.axis=0.7)
154 
+	##extracts nuA for first batch
155 
+	suppressWarnings(nuA <- x$nuA)
156 
+	segments(-1, nuA,
157 
+		 0, nuA, lty=2, col="blue")
158 
+	suppressWarnings(phiA <- x$phiA)
159 
+	##phiA <- fData(x)[["phiA_A"]]
160 
+	segments(0, nuA,
161 
+		 2.5, nuA+2.5*phiA, lwd=2, col="blue")
162 
+	axis(2, at=nuA, labels=expression(hat(nu[A])), cex.axis=0.9)
163 
+	text(0, ylim[1], labels=paste("n =", length(Alist[[1]])), cex=0.8)
164 
+	text(1, ylim[1], labels=paste("n =", length(Alist[[2]])), cex=0.8)
165 
+	text(2, ylim[1], labels=paste("n =", length(Alist[[3]])), cex=0.8)
166 
+##	segments(0.5, nuA+0.5*phiA,
167 
+##		 1, pretty(ylim, n=5)[2], lty=2, col="blue")
168 
+##	segments(1, pretty(ylim, n=5)[2],
169 
+##		 1.2, pretty(ylim)[2], lty=2, col="blue")
170 
+##	text(1.25, pretty(ylim)[2], pos=4,
171 
+##	     labels=expression(hat(nu[A]) + c[A]*hat(phi[A])))
172 
+	legend("topleft", fill=rev(cols), legend=c("AA", "AB", "BB"))##, title="diallelic genotypes")
173 
+
174 
+	ylim <- range(unlist(Blist))
175 
+	boxplot(Blist, xaxt="n", ylab=expression(I[B]),
176 
+		##xlab="diallelic genotypes",
177 
+		cex.axis=0.6,
178 
+		ylim=range(unlist(Blist), na.rm=TRUE),
179 
+		border="grey50", xaxs="i",
180 
+		at=0:2, xlim=c(-0.5, 2.5),
181 
+		cex.main=0.9, yaxt="n",
182 
+		col=rev(cols))
183 
+	axis(2, at=pretty(ylim), cex.axis=0.8)
184 
+	axis(1, at=0:2, labels=c("0B (AA genotype)", "1B (AB genotype)", "2B (BB genotype)"), cex.axis=0.7)
185 
+	##nuB <- fData(x)[["nuB_A"]]
186 
+	suppressWarnings(nuB <- x$nuB)
187 
+	segments(-1, nuB,
188 
+		 0, nuB, lty=2, col="blue")
189 
+	##phiB <- fData(x[i,])[["phiB_A"]]
190 
+	suppressWarnings(phiB <- x$phiB)
191 
+	segments(0, nuB,
192 
+		 2.5, nuB+2.5*phiB, lwd=2, col="blue")
193 
+	axis(2, at=nuB, labels=expression(hat(nu[B])), cex.axis=0.9)
194 
+	text(0, ylim[1], labels=paste("n =", length(Blist[[1]])), cex=0.8)
195 
+	text(1, ylim[1], labels=paste("n =", length(Blist[[2]])), cex=0.8)
196 
+	text(2, ylim[1], labels=paste("n =", length(Blist[[3]])), cex=0.8)
197 
+##	segments(0.5, nuB+0.5*phiB,
198 
+##		 1, pretty(ylim,n=5)[2], lty=2, col="blue")
199 
+##	segments(1, pretty(ylim, n=5)[2],
200 
+##		 1.2, pretty(ylim,n=5)[2], lty=2, col="blue")
201 
+##	text(1.25, pretty(ylim,n=5)[2], pos=4, labels=expression(hat(nu[B]) + c[B]*hat(phi[B])))
202 
+	mtext(featureNames(x)[i], 3, outer=TRUE, line=1)
203 
+})
Browse code

several updates to vignette, documentation, and copy number for illumina.

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

Rob Scharp authored on 13/08/2009 19:47:13
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ 43b13ec
... ... 
@@ -35,13 +35,18 @@ setMethod("[", "CrlmmSetList", function(x, i, j, ..., drop = FALSE){
35 35 
 ##})
36 36
37 37 
 setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
38 
+
39 
+setMethod("annotation", "CrlmmSetList", function(object) annotation(object[[1]]))
40 
+
38 41 
 setMethod("B", "CrlmmSetList", function(object) B(object[[1]]))
39 42
40 43 
 setMethod("CA", "CrlmmSetList", function(object, ...) CA(object[[3]], ...))
41 44 
 setMethod("CB", "CrlmmSetList", function(object, ...) CB(object[[3]], ...))
42 45
43 46 
 setMethod("calls", "CrlmmSetList", function(object) calls(object[[2]]))
44 
-setMethod("cnIndex", "CrlmmSetList", function(object) match(cnNames(object[[1]]), featureNames(object)))
47 
+setMethod("cnIndex", "CrlmmSetList", function(object, ...) {
48 
+	match(cnNames(object[[1]], annotation(object)), featureNames(object))
49 
+})
45 50
46 51 
 setMethod("copyNumber", "CrlmmSetList", function(object) copyNumber(object[[3]]))
47 52
... ... 
@@ -92,11 +97,23 @@ setMethod("points", signature(x="CrlmmSetList"),
92 97 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
93 98
94 99 
 setMethod("show", "CrlmmSetList", function(object){
95 
-	for(i in seq(along=object)) show(object[[i]])
100 
+	##for(i in seq(along=object)) show(object[[i]])
101 
+	cat("\n Elements in CrlmmSetList object: \n")
102 
+	cat("\n")
103 
+	for(i in 1:length(object)){
104 
+		cat("class: ", class(object[[i]]), "\n")
105 
+		cat("assayData elements: ", ls(assayData(object[[i]])), "\n")
106 
+		cat("Dimensions: ", dim(object[[i]]))
107 
+		cat("\n \n")
108 
+	}
109 
+##	cat("\n")
110 
+##	cat("Dimensions:\n")
111 
+##	print(dims(object))
96 112 
 })
97 113
98 114 
 setMethod("chromosome", "CrlmmSetList", function(object) chromosome(object[[3]]))
99 115 
 setMethod("position", "CrlmmSetList", function(object) position(object[[3]]))
116 
+setMethod("confs", "CrlmmSetList", function(object) confs(object[[2]]))
100 117
101 118
102 119 
 setMethod(".harmonizeDimnames", "CrlmmSetList", function(object){
... ... 
@@ -126,7 +143,9 @@ setMethod("$", "CrlmmSetList", function(x, name) {
126 143 
 })
127 144
128 145
129 
-setMethod("snpIndex", "CrlmmSetList", function(object) match(snpNames(object[[1]]), featureNames(object)))
146 
+setMethod("snpIndex", "CrlmmSetList", function(object, ...){
147 
+	match(snpNames(object[[1]], annotation(object)), featureNames(object))
148 
+})
130 149 
 setMethod("splitByChromosome", "CrlmmSetList", function(object, cdfName, outdir){
131 150 
 	path <- system.file("extdata", package=paste(cdfName, "Crlmm", sep=""))
132 151 
 	load(file.path(path, "snpProbes.rda"))
... ... 
@@ -139,8 +158,9 @@ setMethod("splitByChromosome", "CrlmmSetList", function(object, cdfName, outdir)
139 158 
 		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
140 159 
 		index <- c(match(snps, featureNames(object)),
141 160 
 			   match(cnps, featureNames(object)))
142 
-		crlmmResults <- object[index, ]
143 
-		save(crlmmResults, file=file.path(outdir, paste("crlmmResults_", CHR, ".rda", sep="")))
161 
+		index <- index[!is.na(index)]
162 
+		crlmmSetList <- object[index, ]
163 
+		save(crlmmSetList, file=file.path(outdir, paste("crlmmSetList_", CHR, ".rda", sep="")))
144 164 
 	}
145 165 
 })
146 166
Browse code

Removed scanDate slot from eSet and replaced it with protocolData slot. Also updated eSet objects and bumped package version numbers.

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

Patrick Aboyoun authored on 24/07/2009 03:16:33
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ 4b098e3
... ... 
@@ -90,11 +90,6 @@ setMethod("points", signature(x="CrlmmSetList"),
90 90 
 	  })
91 91
92 92 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
93 
-setMethod("scanDates", "CrlmmSetList", function(object) scanDates(object[[1]]))
94 
-setReplaceMethod("scanDates", signature(object="CrlmmSetList", value="character"), function(object, value){
95 
-	scanDates(object[[1]]) <- value
96 
-	return(object)
97 
-})
98 93
99 94 
 setMethod("show", "CrlmmSetList", function(object){
100 95 
 	for(i in seq(along=object)) show(object[[i]])
Browse code

added scanDates<- for CrlmmSetList. Suggests VanillaICE>=1.7.8

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

Rob Scharp authored on 16/07/2009 13:32:48
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ c336ded
... ... 
@@ -91,6 +91,11 @@ setMethod("points", signature(x="CrlmmSetList"),
91 91
92 92 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
93 93 
 setMethod("scanDates", "CrlmmSetList", function(object) scanDates(object[[1]]))
94 
+setReplaceMethod("scanDates", signature(object="CrlmmSetList", value="character"), function(object, value){
95 
+	scanDates(object[[1]]) <- value
96 
+	return(object)
97 
+})
98 
+
94 99 
 setMethod("show", "CrlmmSetList", function(object){
95 100 
 	for(i in seq(along=object)) show(object[[i]])
96 101 
 })
Browse code

computeCopynumber returns CrlmmSetList object

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

Rob Scharp authored on 14/07/2009 17:22:19
Showing 1 changed files
R/methods-CrlmmSetList.R
History View file @ b9c7172
... ... 
@@ -23,11 +23,28 @@ setMethod("[", "CrlmmSetList", function(x, i, j, ..., drop = FALSE){
23 23 
 	as(x, "CrlmmSetList")
24 24 
 })
25 25
26 
+##setReplaceMethod("[[", "CrlmmSetList", function(x, i, j, ..., value) {
27 
+##	browser()
28 
+##	##otherwise infinite recursion
29 
+##	x <- as(x, "list")
30 
+##	x[[i]] <- value
31 
+##	x <- as(x, "CrlmmSetList")
32 
+##	x <- .harmonizeDimnames(x)
33 
+##	stopifnot(identical(featureNames(x[[i]]), featureNames(x[[1]])))
34 
+##	return(x)
35 
+##})
36 
+
26 37 
 setMethod("A", "CrlmmSetList", function(object) A(object[[1]]))
27 38 
 setMethod("B", "CrlmmSetList", function(object) B(object[[1]]))
39 
+
40 
+setMethod("CA", "CrlmmSetList", function(object, ...) CA(object[[3]], ...))
41 
+setMethod("CB", "CrlmmSetList", function(object, ...) CB(object[[3]], ...))
42 
+
28 43 
 setMethod("calls", "CrlmmSetList", function(object) calls(object[[2]]))
29 44 
 setMethod("cnIndex", "CrlmmSetList", function(object) match(cnNames(object[[1]]), featureNames(object)))
30 45
46 
+setMethod("copyNumber", "CrlmmSetList", function(object) copyNumber(object[[3]]))
47 
+
31 48 
 setMethod("combine", signature=signature(x="CrlmmSetList", y="CrlmmSetList"),
32 49 
           function(x, y, ...){
33 50 
 		  x.abset <- x[[1]]
... ... 
@@ -52,8 +69,12 @@ setMethod("combine", signature=signature(x="CrlmmSetList", y="CrlmmSetList"),
52 69
53 70
54 71
72 
+##setMethod("fData", "CrlmmSetList", function(object) featureNames(object[[1]]))
73 
+
55 74 
 setMethod("featureNames", "CrlmmSetList", function(object) featureNames(object[[1]]))
56 75
76 
+setMethod("ncol", signature(x="CrlmmSetList"), function(x) ncol(x[[1]]))
77 
+setMethod("nrow", signature(x="CrlmmSetList"), function(x) nrow(x[[1]]))
57 78 
 setMethod("plot", signature(x="CrlmmSetList"),
58 79 
 	  function(x, y, ...){
59 80 
 		  A <- log2(A(x))
... ... 
@@ -71,18 +92,51 @@ setMethod("points", signature(x="CrlmmSetList"),
71 92 
 setMethod("sampleNames", "CrlmmSetList", function(object) sampleNames(object[[1]]))
72 93 
 setMethod("scanDates", "CrlmmSetList", function(object) scanDates(object[[1]]))
73 94 
 setMethod("show", "CrlmmSetList", function(object){
74 
-	show(object[[1]])
75 
-	show(object[[2]])
95 
+	for(i in seq(along=object)) show(object[[i]])