... | ... |
@@ -1,5 +1,5 @@ |
1 | 1 |
Package: GSVA |
2 |
-Version: 1.25.5 |
|
2 |
+Version: 1.25.6 |
|
3 | 3 |
Title: Gene Set Variation Analysis for microarray and RNA-seq data |
4 | 4 |
Authors@R: c(person("Justin", "Guinney", role=c("aut", "cre"), email="justin.guinney@sagebase.org"), |
5 | 5 |
person("Robert", "Castelo", role="aut", email="robert.castelo@upf.edu"), |
... | ... |
@@ -9,19 +9,20 @@ setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="list"), |
9 | 9 |
function(expr, gset.idx.list, annotation, |
10 | 10 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
11 | 11 |
kcdf=c("Gaussian", "Poisson", "none"), |
12 |
- rnaseq=FALSE, |
|
12 |
+ rnaseq=FALSE, ## deprecated |
|
13 | 13 |
abs.ranking=FALSE, |
14 | 14 |
min.sz=1, |
15 | 15 |
max.sz=Inf, |
16 |
- no.bootstraps=0, |
|
17 |
- bootstrap.percent = .632, |
|
16 |
+ no.bootstraps=0, ## deprecated |
|
17 |
+ bootstrap.percent = .632, ## deprecated |
|
18 | 18 |
parallel.sz=0, |
19 | 19 |
parallel.type="SOCK", |
20 | 20 |
mx.diff=TRUE, |
21 | 21 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
22 |
- kernel=TRUE, |
|
22 |
+ kernel=TRUE, ## deprecated |
|
23 | 23 |
ssgsea.norm=TRUE, |
24 |
- verbose=TRUE) |
|
24 |
+ verbose=TRUE, |
|
25 |
+ return.old.value=FALSE) ## transient argument for deprecating 'no.bootstraps' and 'bootstrap.percent' |
|
25 | 26 |
{ |
26 | 27 |
method <- match.arg(method) |
27 | 28 |
kcdf <- match.arg(kcdf) |
... | ... |
@@ -32,6 +33,9 @@ setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="list"), |
32 | 33 |
if (!missing(kernel)) |
33 | 34 |
warning("The argument 'kernel' is deprecated and will be removed in the next release of GSVA. Please use the 'kcdf' argument instead.") |
34 | 35 |
|
36 |
+ if (no.bootstraps > 0) |
|
37 |
+ warning("The argument 'no.bootstraps' is deprecated and will be removed in the next release of GSVA. This implies that the 'gsva()' function with the default argument 'method=\"gsva\"' only returns a matrix of GSVA enrichment scores. To obtain the same output in the form of a list as in previous versions you can set 'return.old.value=TRUE' during this release but this argument will not be available anymore in the next release.") |
|
38 |
+ |
|
35 | 39 |
## filter out genes with constant expression values |
36 | 40 |
sdGenes <- Biobase::esApply(expr, 1, sd) |
37 | 41 |
if (any(sdGenes == 0) || any(is.na(sdGenes))) { |
... | ... |
@@ -81,28 +85,31 @@ setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="list"), |
81 | 85 |
eScoEset <- new("ExpressionSet", exprs=eSco$es.obs, phenoData=phenoData(expr), |
82 | 86 |
experimentData=experimentData(expr), annotation="") |
83 | 87 |
|
84 |
- return(list(es.obs=eScoEset, |
|
85 |
- bootstrap=eSco$bootstrap, |
|
86 |
- p.vals.sign=eSco$p.vals.sign)) |
|
88 |
+ rval <- eScoEset |
|
89 |
+ if (return.old.value) ## to be removed in the next release |
|
90 |
+ rval <- list(es.obs=eScoEset, bootstrap=eSco$bootstrap, p.vals.sign=eSco$p.vals.sign) |
|
91 |
+ |
|
92 |
+ rval |
|
87 | 93 |
}) |
88 | 94 |
|
89 | 95 |
setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="GeneSetCollection"), |
90 | 96 |
function(expr, gset.idx.list, annotation, |
91 | 97 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
92 | 98 |
kcdf=c("Gaussian", "Poisson", "none"), |
93 |
- rnaseq=FALSE, |
|
99 |
+ rnaseq=FALSE, ## deprecated |
|
94 | 100 |
abs.ranking=FALSE, |
95 | 101 |
min.sz=1, |
96 | 102 |
max.sz=Inf, |
97 |
- no.bootstraps=0, |
|
98 |
- bootstrap.percent = .632, |
|
103 |
+ no.bootstraps=0, ## deprecated |
|
104 |
+ bootstrap.percent = .632, ## deprecated |
|
99 | 105 |
parallel.sz=0, |
100 | 106 |
parallel.type="SOCK", |
101 | 107 |
mx.diff=TRUE, |
102 | 108 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
103 |
- kernel=TRUE, |
|
109 |
+ kernel=TRUE, ## deprecated |
|
104 | 110 |
ssgsea.norm=TRUE, |
105 |
- verbose=TRUE) |
|
111 |
+ verbose=TRUE, |
|
112 |
+ return.old.value=FALSE) ## transient argument for deprecating 'no.bootstraps' and 'bootstrap.percent' |
|
106 | 113 |
{ |
107 | 114 |
method <- match.arg(method) |
108 | 115 |
kcdf <- match.arg(kcdf) |
... | ... |
@@ -113,6 +120,9 @@ setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="GeneSetCollecti |
113 | 120 |
if (!missing(kernel)) |
114 | 121 |
warning("The argument 'kernel' is deprecated and will be removed in the next release of GSVA. Please use the 'kcdf' argument instead.") |
115 | 122 |
|
123 |
+ if (no.bootstraps > 0) |
|
124 |
+ warning("The argument 'no.bootstraps' is deprecated and will be removed in the next release of GSVA. This implies that the 'gsva()' function with the default argument 'method=\"gsva\"' only returns a matrix of GSVA enrichment scores. To obtain the same output in the form of a list as in previous versions you can set 'return.old.value=TRUE' during this release but this argument will not be available anymore in the next release.") |
|
125 |
+ |
|
116 | 126 |
## filter out genes with constant expression values |
117 | 127 |
sdGenes <- Biobase::esApply(expr, 1, sd) |
118 | 128 |
if (any(sdGenes == 0) || any(is.na(sdGenes))) { |
... | ... |
@@ -166,28 +176,31 @@ setMethod("gsva", signature(expr="ExpressionSet", gset.idx.list="GeneSetCollecti |
166 | 176 |
eScoEset <- new("ExpressionSet", exprs=eSco$es.obs, phenoData=phenoData(expr), |
167 | 177 |
experimentData=experimentData(expr), annotation="") |
168 | 178 |
|
169 |
- return(list(es.obs=eScoEset, |
|
170 |
- bootstrap=eSco$bootstrap, |
|
171 |
- p.vals.sign=eSco$p.vals.sign)) |
|
179 |
+ rval <- eScoEset |
|
180 |
+ if (return.old.value) ## to be removed in the next release |
|
181 |
+ rval <- list(es.obs=eScoEset, bootstrap=eSco$bootstrap, p.vals.sign=eSco$p.vals.sign) |
|
182 |
+ |
|
183 |
+ rval |
|
172 | 184 |
}) |
173 | 185 |
|
174 | 186 |
setMethod("gsva", signature(expr="matrix", gset.idx.list="GeneSetCollection"), |
175 | 187 |
function(expr, gset.idx.list, annotation, |
176 | 188 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
177 | 189 |
kcdf=c("Gaussian", "Poisson", "none"), |
178 |
- rnaseq=FALSE, |
|
190 |
+ rnaseq=FALSE, ## deprecated |
|
179 | 191 |
abs.ranking=FALSE, |
180 | 192 |
min.sz=1, |
181 | 193 |
max.sz=Inf, |
182 |
- no.bootstraps=0, |
|
183 |
- bootstrap.percent = .632, |
|
194 |
+ no.bootstraps=0, ## deprecated |
|
195 |
+ bootstrap.percent = .632, ## deprecated |
|
184 | 196 |
parallel.sz=0, |
185 | 197 |
parallel.type="SOCK", |
186 | 198 |
mx.diff=TRUE, |
187 | 199 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
188 |
- kernel=TRUE, |
|
200 |
+ kernel=TRUE, ## deprecated |
|
189 | 201 |
ssgsea.norm=TRUE, |
190 |
- verbose=TRUE) |
|
202 |
+ verbose=TRUE, |
|
203 |
+ return.old.value=FALSE) ## transient argument for deprecating 'no.bootstraps' and 'bootstrap.percent' |
|
191 | 204 |
{ |
192 | 205 |
method <- match.arg(method) |
193 | 206 |
kcdf <- match.arg(kcdf) |
... | ... |
@@ -198,6 +211,9 @@ setMethod("gsva", signature(expr="matrix", gset.idx.list="GeneSetCollection"), |
198 | 211 |
if (!missing(kernel)) |
199 | 212 |
warning("The argument 'kernel' is deprecated and will be removed in the next release of GSVA. Please use the 'kcdf' argument instead.") |
200 | 213 |
|
214 |
+ if (no.bootstraps > 0) |
|
215 |
+ warning("The argument 'no.bootstraps' is deprecated and will be removed in the next release of GSVA. This implies that the 'gsva()' function with the default argument 'method=\"gsva\"' only returns a matrix of GSVA enrichment scores. To obtain the same output in the form of a list as in previous versions you can set 'return.old.value=TRUE' during this release but this argument will not be available anymore in the next release.") |
|
216 |
+ |
|
201 | 217 |
## filter out genes with constant expression values |
202 | 218 |
sdGenes <- apply(expr, 1, sd) |
203 | 219 |
if (any(sdGenes == 0) || any(is.na(sdGenes))) { |
... | ... |
@@ -248,28 +264,34 @@ setMethod("gsva", signature(expr="matrix", gset.idx.list="GeneSetCollection"), |
248 | 264 |
kernel <- FALSE |
249 | 265 |
} |
250 | 266 |
|
251 |
- .gsva(expr, mapped.gset.idx.list, method, kcdf, rnaseq, abs.ranking, |
|
252 |
- no.bootstraps, bootstrap.percent, parallel.sz, parallel.type, |
|
253 |
- mx.diff, tau, kernel, ssgsea.norm, verbose) |
|
267 |
+ rval <- .gsva(expr, mapped.gset.idx.list, method, kcdf, rnaseq, abs.ranking, |
|
268 |
+ no.bootstraps, bootstrap.percent, parallel.sz, parallel.type, |
|
269 |
+ mx.diff, tau, kernel, ssgsea.norm, verbose) |
|
270 |
+ |
|
271 |
+ if (method == "gsva" && !return.old.value) ## to be removed in the next release |
|
272 |
+ rval <- rval$es.obs |
|
273 |
+ |
|
274 |
+ rval |
|
254 | 275 |
}) |
255 | 276 |
|
256 | 277 |
setMethod("gsva", signature(expr="matrix", gset.idx.list="list"), |
257 | 278 |
function(expr, gset.idx.list, annotation, |
258 | 279 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
259 | 280 |
kcdf=c("Gaussian", "Poisson", "none"), |
260 |
- rnaseq=FALSE, |
|
281 |
+ rnaseq=FALSE, ## deprecated |
|
261 | 282 |
abs.ranking=FALSE, |
262 | 283 |
min.sz=1, |
263 | 284 |
max.sz=Inf, |
264 |
- no.bootstraps=0, |
|
265 |
- bootstrap.percent = .632, |
|
285 |
+ no.bootstraps=0, ## deprecated |
|
286 |
+ bootstrap.percent = .632, ## deprecated |
|
266 | 287 |
parallel.sz=0, |
267 | 288 |
parallel.type="SOCK", |
268 | 289 |
mx.diff=TRUE, |
269 | 290 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
270 |
- kernel=TRUE, |
|
291 |
+ kernel=TRUE, ## deprecated |
|
271 | 292 |
ssgsea.norm=TRUE, |
272 |
- verbose=TRUE) |
|
293 |
+ verbose=TRUE, |
|
294 |
+ return.old.value=FALSE) ## transient argument for deprecating 'no.bootstraps' and 'bootstrap.percent' |
|
273 | 295 |
{ |
274 | 296 |
method <- match.arg(method) |
275 | 297 |
kcdf <- match.arg(kcdf) |
... | ... |
@@ -280,6 +302,9 @@ setMethod("gsva", signature(expr="matrix", gset.idx.list="list"), |
280 | 302 |
if (!missing(kernel)) |
281 | 303 |
warning("The argument 'kernel' is deprecated and will be removed in the next release of GSVA. Please use the 'kcdf' argument instead.") |
282 | 304 |
|
305 |
+ if (no.bootstraps > 0) |
|
306 |
+ warning("The argument 'no.bootstraps' is deprecated and will be removed in the next release of GSVA. This implies that the 'gsva()' function with the default argument 'method=\"gsva\"' only returns a matrix of GSVA enrichment scores. To obtain the same output in the form of a list as in previous versions you can set 'return.old.value=TRUE' during this release but this argument will not be available anymore in the next release.") |
|
307 |
+ |
|
283 | 308 |
## filter out genes with constant expression values |
284 | 309 |
sdGenes <- apply(expr, 1, sd) |
285 | 310 |
if (any(sdGenes == 0) || any(is.na(sdGenes))) { |
... | ... |
@@ -318,9 +343,14 @@ setMethod("gsva", signature(expr="matrix", gset.idx.list="list"), |
318 | 343 |
kernel <- FALSE |
319 | 344 |
} |
320 | 345 |
|
321 |
- .gsva(expr, mapped.gset.idx.list, method, kcdf, rnaseq, abs.ranking, no.bootstraps, |
|
322 |
- bootstrap.percent, parallel.sz, parallel.type, |
|
323 |
- mx.diff, tau, kernel, ssgsea.norm, verbose) |
|
346 |
+ rval <- .gsva(expr, mapped.gset.idx.list, method, kcdf, rnaseq, abs.ranking, no.bootstraps, |
|
347 |
+ bootstrap.percent, parallel.sz, parallel.type, |
|
348 |
+ mx.diff, tau, kernel, ssgsea.norm, verbose) |
|
349 |
+ |
|
350 |
+ if (method == "gsva" && !return.old.value) ## to be removed in the next release |
|
351 |
+ rval <- rval$es.obs |
|
352 |
+ |
|
353 |
+ rval |
|
324 | 354 |
}) |
325 | 355 |
|
326 | 356 |
.gsva <- function(expr, gset.idx.list, |
... | ... |
@@ -452,7 +482,7 @@ setMethod("gsva", signature(expr="matrix", gset.idx.list="list"), |
452 | 482 |
n.cycles <- floor(no.bootstraps / parallel.sz) |
453 | 483 |
for(i in 1:n.cycles){ |
454 | 484 |
if(verbose) cat("bootstrap cycle ", i, "\n") |
455 |
- r <- clEvalQ(cl, GSVA:::compute.geneset.es(expr, gset.idx.list, |
|
485 |
+ r <- clEvalQ(cl, compute.geneset.es(expr, gset.idx.list, |
|
456 | 486 |
sample(n.samples, bootstrap.nsamples, replace=T), |
457 | 487 |
rnaseq=rnaseq, abs.ranking=abs.ranking, mx.diff=mx.diff, |
458 | 488 |
tau=tau, kernel=kernel, verbose=FALSE, parallel.sz=1)) |
... | ... |
@@ -271,17 +271,17 @@ gsva_information <- function(input, output, session) { |
271 | 271 |
else |
272 | 272 |
{ |
273 | 273 |
|
274 |
- resultInformation <- matrix(data = c(input$matrixVar,input$genesetVar,ncol(generated_gsva$es.obs),nrow(generated_gsva$es.obs)), nrow = 1, ncol = 4) |
|
274 |
+ resultInformation <- matrix(data = c(input$matrixVar,input$genesetVar,ncol(generated_gsva),nrow(generated_gsva)), nrow = 1, ncol = 4) |
|
275 | 275 |
colnames(resultInformation) <- c("Matrix used","GeneSet used", "Col num", "Row num") |
276 | 276 |
output$result <- renderTable(resultInformation) |
277 |
- if(class(generated_gsva$es.obs) == "ExpressionSet") #If the generated gsva is an ExpressionSet |
|
277 |
+ if(class(generated_gsva) == "ExpressionSet") #If the generated gsva is an ExpressionSet |
|
278 | 278 |
{ |
279 |
- expressionSetObs <- exprs(generated_gsva$es.obs) |
|
279 |
+ expressionSetObs <- exprs(generated_gsva) |
|
280 | 280 |
output$plot <- renderPlot(multidensity(as.list(as.data.frame(expressionSetObs)), legend=NA, las=1, xlab=sprintf("%s scores", input$method), main="", lwd=2)) |
281 | 281 |
} |
282 | 282 |
else |
283 | 283 |
{ |
284 |
- output$plot <- renderPlot(multidensity(as.list(as.data.frame(generated_gsva$es.obs)), legend=NA, las=1, xlab=sprintf("%s scores", input$method), main="", lwd=2)) |
|
284 |
+ output$plot <- renderPlot(multidensity(as.list(as.data.frame(generated_gsva)), legend=NA, las=1, xlab=sprintf("%s scores", input$method), main="", lwd=2)) |
|
285 | 285 |
} |
286 | 286 |
tagList( |
287 | 287 |
downloadButton('downloadData', 'Download'), |
... | ... |
@@ -304,15 +304,15 @@ download_handler <- function(input, output, session) { |
304 | 304 |
} |
305 | 305 |
else |
306 | 306 |
{ |
307 |
- if(class(generated_gsva$es.obs) == "ExpressionSet") #If the generated gsva es.obs is an ExpressionSet |
|
307 |
+ if(class(generated_gsva) == "ExpressionSet") #If the generated gsva result value is an ExpressionSet |
|
308 | 308 |
{ |
309 |
- expressionSetObs <- exprs(generated_gsva$es.obs) |
|
309 |
+ expressionSetObs <- exprs(generated_gsva) |
|
310 | 310 |
dataFrameObs <- as.data.frame(expressionSetObs) |
311 | 311 |
write.csv(dataFrameObs, file) |
312 | 312 |
} |
313 | 313 |
else |
314 | 314 |
{ |
315 |
- dataFrameObs <- as.data.frame(generated_gsva$es.obs) |
|
315 |
+ dataFrameObs <- as.data.frame(generated_gsva) |
|
316 | 316 |
write.csv(dataFrameObs, file) |
317 | 317 |
} |
318 | 318 |
} |
... | ... |
@@ -29,7 +29,8 @@ Estimates GSVA enrichment scores. |
29 | 29 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
30 | 30 |
kernel=TRUE, |
31 | 31 |
ssgsea.norm=TRUE, |
32 |
- verbose=TRUE) |
|
32 |
+ verbose=TRUE, |
|
33 |
+ return.old.value=FALSE) |
|
33 | 34 |
\S4method{gsva}{ExpressionSet,GeneSetCollection}(expr, gset.idx.list, annotation, |
34 | 35 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
35 | 36 |
kcdf=c("Gaussian", "Poisson", "none"), |
... | ... |
@@ -45,7 +46,8 @@ Estimates GSVA enrichment scores. |
45 | 46 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
46 | 47 |
kernel=TRUE, |
47 | 48 |
ssgsea.norm=TRUE, |
48 |
- verbose=TRUE) |
|
49 |
+ verbose=TRUE, |
|
50 |
+ return.old.value=FALSE) |
|
49 | 51 |
\S4method{gsva}{matrix,GeneSetCollection}(expr, gset.idx.list, annotation, |
50 | 52 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
51 | 53 |
kcdf=c("Gaussian", "Poisson", "none"), |
... | ... |
@@ -61,7 +63,8 @@ Estimates GSVA enrichment scores. |
61 | 63 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
62 | 64 |
kernel=TRUE, |
63 | 65 |
ssgsea.norm=TRUE, |
64 |
- verbose=TRUE) |
|
66 |
+ verbose=TRUE, |
|
67 |
+ return.old.value=FALSE) |
|
65 | 68 |
\S4method{gsva}{matrix,list}(expr, gset.idx.list, annotation, |
66 | 69 |
method=c("gsva", "ssgsea", "zscore", "plage"), |
67 | 70 |
kcdf=c("Gaussian", "Poisson", "none"), |
... | ... |
@@ -77,7 +80,8 @@ Estimates GSVA enrichment scores. |
77 | 80 |
tau=switch(method, gsva=1, ssgsea=0.25, NA), |
78 | 81 |
kernel=TRUE, |
79 | 82 |
ssgsea.norm=TRUE, |
80 |
- verbose=TRUE) |
|
83 |
+ verbose=TRUE, |
|
84 |
+ return.old.value=FALSE) |
|
81 | 85 |
} |
82 | 86 |
\arguments{ |
83 | 87 |
\item{expr}{Gene expression data which can be given either as an \code{ExpressionSet} |
... | ... |
@@ -118,8 +122,10 @@ Estimates GSVA enrichment scores. |
118 | 122 |
enriched on either extreme (high or low) will be regarded as 'highly' activated.} |
119 | 123 |
\item{min.sz}{Minimum size of the resulting gene sets.} |
120 | 124 |
\item{max.sz}{Maximum size of the resulting gene sets.} |
121 |
- \item{no.bootstraps}{Number of bootstrap iterations to perform.} |
|
122 |
- \item{bootstrap.percent}{.632 is the ideal percent samples bootstrapped.} |
|
125 |
+ \item{no.bootstraps}{Number of bootstrap iterations to perform. This argument has been deprecated and will |
|
126 |
+ be removed in the next release.} |
|
127 |
+ \item{bootstrap.percent}{.632 is the ideal percent samples bootstrapped. This argument has been deprecated and |
|
128 |
+ will be removed in the next release.} |
|
123 | 129 |
\item{parallel.sz}{Number of processors to use when doing the calculations in parallel. |
124 | 130 |
This requires to previously load either the \code{parallel} or the |
125 | 131 |
\code{snow} library. If \code{parallel} is loaded and this argument |
... | ... |
@@ -145,6 +151,11 @@ Estimates GSVA enrichment scores. |
145 | 151 |
the minimum and the maximum, as described in their paper. When \code{ssgsea.norm=FALSE} |
146 | 152 |
this last normalization step is skipped.} |
147 | 153 |
\item{verbose}{Gives information about each calculation step. Default: \code{FALSE}.} |
154 |
+ \item{return.old.value}{Logical, set to \code{FALSE} (default) has no effect but when \code{return.old.value=TRUE}, |
|
155 |
+ then the return value takes form of a \code{list} object as in previous versions of |
|
156 |
+ GSVA. This argument will be present only in this release for backward compability |
|
157 |
+ purposes during the deprecation of the arguments \code{no.bootstraps} and \code{bootstrap.percent} |
|
158 |
+ and will dissappear in the next release.} |
|
148 | 159 |
} |
149 | 160 |
|
150 | 161 |
\details{ |
... | ... |
@@ -216,7 +227,7 @@ fit <- eBayes(fit) |
216 | 227 |
topTable(fit, coef="sampleGroup2vs1") |
217 | 228 |
|
218 | 229 |
## estimate GSVA enrichment scores for the three sets |
219 |
-gsva_es <- gsva(y, geneSets, mx.diff=1)$es.obs |
|
230 |
+gsva_es <- gsva(y, geneSets, mx.diff=1) |
|
220 | 231 |
|
221 | 232 |
## fit the same linear model now to the GSVA enrichment scores |
222 | 233 |
fit <- lmFit(gsva_es, design) |
... | ... |
@@ -172,8 +172,8 @@ X <- matrix(rnorm(p*n), nrow=p, dimnames=list(1:p, 1:n)) |
172 | 172 |
dim(X) |
173 | 173 |
gs <- as.list(sample(min.sz:max.sz, size=nGS, replace=TRUE)) ## sample gene set sizes |
174 | 174 |
gs <- lapply(gs, function(n, p) sample(1:p, size=n, replace=FALSE), p) ## sample gene sets |
175 |
-es.max <- gsva(X, gs, mx.diff=FALSE, verbose=FALSE, parallel.sz=1)$es.obs |
|
176 |
-es.dif <- gsva(X, gs, mx.diff=TRUE, verbose=FALSE, parallel.sz=1)$es.obs |
|
175 |
+es.max <- gsva(X, gs, mx.diff=FALSE, verbose=FALSE, parallel.sz=1) |
|
176 |
+es.dif <- gsva(X, gs, mx.diff=TRUE, verbose=FALSE, parallel.sz=1) |
|
177 | 177 |
@ |
178 | 178 |
|
179 | 179 |
\begin{center} |
... | ... |
@@ -409,7 +409,7 @@ GSVA enrichment scores, we leave deliberately unchanged the default argument |
409 | 409 |
|
410 | 410 |
<<>>= |
411 | 411 |
cache(leukemia_es <- gsva(leukemia_filtered_eset, c2BroadSets, |
412 |
- min.sz=10, max.sz=500, verbose=TRUE)$es.obs, |
|
412 |
+ min.sz=10, max.sz=500, verbose=TRUE), |
|
413 | 413 |
dir=cacheDir, prefix=cachePrefix) |
414 | 414 |
@ |
415 | 415 |
We test whether there is a difference between the GSVA enrichment scores from each |
... | ... |
@@ -572,7 +572,7 @@ GSVA enrichment scores for the gene sets contained in \Robject{brainTxDbSets} |
572 | 572 |
are calculated, in this case using \Robject{mx.diff=FALSE}, as follows: |
573 | 573 |
|
574 | 574 |
<<>>= |
575 |
-gbm_es <- gsva(gbm_eset, brainTxDbSets, mx.diff=FALSE, verbose=FALSE, parallel.sz=1)$es.obs |
|
575 |
+gbm_es <- gsva(gbm_eset, brainTxDbSets, mx.diff=FALSE, verbose=FALSE, parallel.sz=1) |
|
576 | 576 |
@ |
577 | 577 |
Figure \ref{gbmSignature} shows the GSVA enrichment scores obtained for the |
578 | 578 |
up-regulated gene sets across the samples of the four GBM subtypes. As expected, |
... | ... |
@@ -664,7 +664,7 @@ runSim <- function(p, n, gs.sz, S2N, fracDEgs) { |
664 | 664 |
geneSets <- list(H1GeneSet=paste0("g", 1:(gs.sz)), |
665 | 665 |
H0GeneSet=paste0("g", (gs.sz+1):(2*gs.sz))) |
666 | 666 |
|
667 |
- es.gsva <- gsva(M, geneSets, verbose=FALSE, parallel.sz=1)$es.obs |
|
667 |
+ es.gsva <- gsva(M, geneSets, verbose=FALSE, parallel.sz=1) |
|
668 | 668 |
es.ss <- gsva(M, geneSets, method="ssgsea", verbose=FALSE, parallel.sz=1) |
669 | 669 |
es.z <- gsva(M, geneSets, method="zscore", verbose=FALSE, parallel.sz=1) |
670 | 670 |
es.plage <- gsva(M, geneSets, method="plage", verbose=FALSE, parallel.sz=1) |
... | ... |
@@ -849,10 +849,10 @@ argument should remain unchanged. |
849 | 849 |
|
850 | 850 |
<<<>>= |
851 | 851 |
esmicro <- gsva(huangArrayRMAnoBatchCommon_eset, canonicalC2BroadSets, min.sz=5, max.sz=500, |
852 |
- mx.diff=TRUE, verbose=FALSE, parallel.sz=1)$es.obs |
|
852 |
+ mx.diff=TRUE, verbose=FALSE, parallel.sz=1) |
|
853 | 853 |
dim(esmicro) |
854 | 854 |
esrnaseq <- gsva(pickrellCountsArgonneCQNcommon_eset, canonicalC2BroadSets, min.sz=5, max.sz=500, |
855 |
- kcdf="Poisson", mx.diff=TRUE, verbose=FALSE, parallel.sz=1)$es.obs |
|
855 |
+ kcdf="Poisson", mx.diff=TRUE, verbose=FALSE, parallel.sz=1) |
|
856 | 856 |
dim(esrnaseq) |
857 | 857 |
@ |
858 | 858 |
To compare expression values from both technologies we are going to transform |