- new function normalizeVSN to apply vsn normalization
to limma objects. normalizeBetweenArrays() now longer
supports method="vsn".
- avereps.MAList was not averaging the "other" data matrices
correctly. Now fixed.
- updates to the 04.Background help page, which gives an
overview of background correction functions.
git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/limma@49284 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -1,6 +1,6 @@ |
1 | 1 |
Package: limma |
2 |
-Version: 3.5.19 |
|
3 |
-Date: 2010/08/30 |
|
2 |
+Version: 3.5.20 |
|
3 |
+Date: 2010/09/08 |
|
4 | 4 |
Title: Linear Models for Microarray Data |
5 | 5 |
Author: Gordon Smyth with contributions from Matthew Ritchie, Jeremy Silver, James Wettenhall, Natalie Thorne, Mette Langaas, Egil Ferkingstad, Marcus Davy, Francois Pepin, Dongseok Choi, Di Wu, Alicia Oshlack, Carolyn de Graaf, Yifang Hu, Wei Shi and Belinda Phipson. |
6 | 6 |
Maintainer: Gordon Smyth <[email protected]> |
... | ... |
@@ -193,7 +193,7 @@ avereps.default <- function(x,ID=rownames(x)) |
193 | 193 |
avereps.MAList <- function(x,ID=NULL) |
194 | 194 |
# Average over irregular replicate spots for MAList objects |
195 | 195 |
# Gordon Smyth |
196 |
-# 3 June 2008. |
|
196 |
+# 3 June 2008. Last modified 8 Sep 2010. |
|
197 | 197 |
{ |
198 | 198 |
if(is.null(ID)) { |
199 | 199 |
ID <- x$genes$ID |
... | ... |
@@ -204,7 +204,7 @@ avereps.MAList <- function(x,ID=NULL) |
204 | 204 |
y$M <- avereps(x$M,ID=ID) |
205 | 205 |
y$A <- avereps(x$A,ID=ID) |
206 | 206 |
other <- names(x$other) |
207 |
- for (a in other) object$other[[a]] <- avereps(object$other[[a]],ID=ID) |
|
207 |
+ for (a in other) y$other[[a]] <- avereps(x$other[[a]],ID=ID) |
|
208 | 208 |
y$weights <- avereps(x$weights,ID=ID) |
209 | 209 |
y$genes <- x$genes[!duplicated(ID),] |
210 | 210 |
y$printer <- NULL |
... | ... |
@@ -434,7 +434,7 @@ plotPrintorder <- function(object,layout,start="topleft",slide=1,method="loess", |
434 | 434 |
normalizeBetweenArrays <- function(object, method=NULL, targets=NULL, ...) { |
435 | 435 |
# Normalize between arrays |
436 | 436 |
# Gordon Smyth |
437 |
-# 12 Apri 2003. Last revised 3 July 2009. |
|
437 |
+# 12 Apri 2003. Last revised 9 Sep 2010. |
|
438 | 438 |
|
439 | 439 |
# Check method |
440 | 440 |
if(is.null(method)) { |
... | ... |
@@ -448,6 +448,7 @@ normalizeBetweenArrays <- function(object, method=NULL, targets=NULL, ...) { |
448 | 448 |
} |
449 | 449 |
choices <- c("none","scale","quantile","Aquantile","Gquantile","Rquantile","Tquantile","vsn") |
450 | 450 |
method <- match.arg(method,choices) |
451 |
+ if(method=="vsn") stop("vsn method no longer supported. Please use normalizeVSN instead.") |
|
451 | 452 |
|
452 | 453 |
# Method for matrices |
453 | 454 |
if(is(object,"matrix")) { |
... | ... |
@@ -467,24 +468,6 @@ normalizeBetweenArrays <- function(object, method=NULL, targets=NULL, ...) { |
467 | 468 |
return(object) |
468 | 469 |
} |
469 | 470 |
|
470 |
-# vsn needs special treatment |
|
471 |
- if(method=="vsn") { |
|
472 |
- require("vsn") |
|
473 |
- if(!is.null(object$G) && !is.null(object$R)) { |
|
474 |
- y <- cbind(object$G,object$R) |
|
475 |
- object$G <- object$R <- NULL |
|
476 |
- } else |
|
477 |
- stop("vsn works only on RGList objects or matrices") |
|
478 |
- y <- exprs(vsnMatrix(x=y,...)) |
|
479 |
- n2 <- ncol(y)/2 |
|
480 |
- G <- y[,1:n2] |
|
481 |
- R <- y[,n2+(1:n2)] |
|
482 |
- object$M <- R-G |
|
483 |
- object$A <- (R+G)/2 |
|
484 |
- object <- new("MAList",unclass(object)) |
|
485 |
- return(object) |
|
486 |
- } |
|
487 |
- |
|
488 | 471 |
# From here assume two-color data |
489 | 472 |
if(is(object,"RGList")) object <- MA.RG(object) |
490 | 473 |
if(is.null(object$M) || is.null(object$A)) stop("object doesn't appear to be RGList or MAList object") |
... | ... |
@@ -531,6 +514,49 @@ normalizeBetweenArrays <- function(object, method=NULL, targets=NULL, ...) { |
531 | 514 |
object |
532 | 515 |
} |
533 | 516 |
|
517 |
+ |
|
518 |
+normalizeVSN <- function(x,...) |
|
519 |
+{ |
|
520 |
+ require("vsn") |
|
521 |
+ UseMethod("normalizeVSN") |
|
522 |
+} |
|
523 |
+ |
|
524 |
+normalizeVSN.RGList <- function(x,...) |
|
525 |
+# vsn background correction and normalization for RGList objects |
|
526 |
+# Gordon Smyth |
|
527 |
+# 9 Sep 2010. |
|
528 |
+{ |
|
529 |
+ x <- backgroundCorrect(x,method="subtract") |
|
530 |
+ y <- cbind(x$G,x$R) |
|
531 |
+ x$G <- x$R <- NULL |
|
532 |
+ y <- exprs(vsnMatrix(x=y,...)) |
|
533 |
+ n2 <- ncol(y)/2 |
|
534 |
+ G <- y[,1:n2] |
|
535 |
+ R <- y[,n2+(1:n2)] |
|
536 |
+ x$M <- R-G |
|
537 |
+ x$A <- (R+G)/2 |
|
538 |
+ new("MAList",unclass(x)) |
|
539 |
+} |
|
540 |
+ |
|
541 |
+normalizeVSN.EListRaw <- function(x,...) |
|
542 |
+# vsn background correction and normalization for EListRaw objects |
|
543 |
+# Gordon Smyth |
|
544 |
+# 9 Sep 2010. |
|
545 |
+{ |
|
546 |
+ x <- backgroundCorrect(x,method="subtract") |
|
547 |
+ x$E <- exprs(vsnMatrix(x=x$E,...)) |
|
548 |
+ new("EList",unclass(x)) |
|
549 |
+} |
|
550 |
+ |
|
551 |
+normalizeVSN.default <- function(x,...) |
|
552 |
+# vsn background correction and normalization for matrices |
|
553 |
+# Gordon Smyth |
|
554 |
+# 9 Sep 2010. |
|
555 |
+{ |
|
556 |
+ exprs(vsnMatrix(x=as.matrix(x),...)) |
|
557 |
+} |
|
558 |
+ |
|
559 |
+ |
|
534 | 560 |
normalizeQuantiles <- function(A, ties=TRUE) { |
535 | 561 |
# Normalize columns of a matrix to have the same quantiles, allowing for missing values. |
536 | 562 |
# Gordon Smyth |
... | ... |
@@ -1,3 +1,15 @@ |
1 |
+8 September 2010: limma 2.5.10 |
|
2 |
+ |
|
3 |
+- new function normalizeVSN to apply vsn normalization |
|
4 |
+ to limma objects. normalizeBetweenArrays() now longer |
|
5 |
+ supports method="vsn". |
|
6 |
+ |
|
7 |
+- avereps.MAList was not averaging the "other" data matrices |
|
8 |
+ correctly. Now fixed. |
|
9 |
+ |
|
10 |
+- updates to the 04.Background help page, which gives an |
|
11 |
+ overview of background correction functions. |
|
12 |
+ |
|
1 | 13 |
30 August 2010: limma 2.5.19 |
2 | 14 |
|
3 | 15 |
- The backgroundCorrect() code has been simplified and a |
... | ... |
@@ -3,24 +3,23 @@ |
3 | 3 |
\title{Background Correction} |
4 | 4 |
|
5 | 5 |
\description{ |
6 |
-This page deals with background correction methods for two-color microarray data. |
|
6 |
+This page deals with background correction methods provided by the \code{\link{backgroundCorrect}}, \code{\link{kooperberg}} or \code{\link{neqc}} functions. |
|
7 |
+Microarray data is typically background corrected by one of these functions before normalization and other downstream analysis. |
|
7 | 8 |
|
8 |
-Usually one doesn't need to explicitly ask for background correction of the intensities because this is done by default by \code{\link{normalizeWithinArrays}}, |
|
9 |
-which subtracts the background from the foreground intensities before applying the normalization method. |
|
10 |
-This default background correction method can be over-ridden by using \code{\link{backgroundCorrect}} which offers a number of alternative |
|
11 |
-background correct methods to simple subtraction. |
|
12 |
-The function \code{backgroundCorrect} is used to correct the \code{RGList} before applying \code{normalizeWithinArrays}. |
|
9 |
+\code{backgroundCorrect} works on matrices, \code{EListRaw} or \code{RGList} objects, and calls \code{\link{backgroundCorrect.matrix}}. |
|
13 | 10 |
|
14 | 11 |
The \code{movingmin} method of \code{backgroundCorrect} uses utility functions \code{\link{ma3x3.matrix}} and \code{\link{ma3x3.spottedarray}}. |
15 | 12 |
|
16 | 13 |
The \code{normexp} method of \code{backgroundCorrect} uses utility functions \code{\link{normexp.fit}} and \code{\link{normexp.signal}}. |
17 | 14 |
|
18 |
-\code{\link{neqc}} performs normexp background correction and quantile normalization using control probes. |
|
19 |
-This method uses utility functions \code{\link{normexp.fit.control}} to conduct the background correction. |
|
15 |
+\code{\link{kooperberg}} is a Bayesian background correction tool designed specifically for two-color GenePix data. |
|
16 |
+It is computationally intensive and requires several additional columns from the GenePix data files. |
|
17 |
+These can be read in using \code{read.maimages} and specifying the \code{other.columns} argument. |
|
20 | 18 |
|
21 |
-\code{\link{kooperberg}} is a Bayesian background correction tool designed specifically for GenePix data. |
|
22 |
-\code{kooperberg} is not currently used as the default method for GenePix data because it is computationally intensive. |
|
23 |
-It requires several additional columns from the GenePix data files which can be read in using \code{read.maimages} and specifying the \code{other.columns} argument. |
|
19 |
+\code{\link{neqc}} is for single-color data. |
|
20 |
+It performs normexp background correction and quantile normalization using control probes. |
|
21 |
+It uses utility functions \code{\link{normexp.fit.control}} and \code{\link{normexp.signal}}. |
|
22 |
+If \code{robust=TRUE}, then \code{normexp.fit.control} uses the function \code{huber} in the MASS package. |
|
24 | 23 |
} |
25 | 24 |
|
26 | 25 |
\author{Gordon Smyth} |
... | ... |
@@ -21,6 +21,9 @@ For more details see the \link[=limmaUsersGuide]{LIMMA User's Guide} which inclu |
21 | 21 |
\code{normalizeWithinArrays} uses utility functions \code{\link{MA.RG}}, \code{\link{loessFit}} and \code{\link{normalizeRobustSpline}}. |
22 | 22 |
\code{normalizeBetweenArrays} uses utility functions \code{\link{normalizeMedianAbsValues}} and \code{\link{normalizeQuantiles}}, none of which need to be called directly by users. |
23 | 23 |
|
24 |
+The function \code{\link{normalizeVSN}} is also provided as a interface to the vsn package. |
|
25 |
+It performs variance stabilizing normalization, an algorithm which includes background correction, within and between normalization together, and therefore doesn't fit into the paradigm of the other methods. |
|
26 |
+ |
|
24 | 27 |
\code{removeBatchEffect} can be used to remove a batch effect, associated with hybridization time or some other technical variable, prior to unsupervised analysis. |
25 | 28 |
} |
26 | 29 |
|
... | ... |
@@ -10,7 +10,7 @@ backgroundCorrect(RG, method="auto", offset=0, printer=RG$printer, normexp.metho |
10 | 10 |
backgroundCorrect.matrix(E, Eb=NULL, method="auto", offset=0, printer=NULL, normexp.method="saddle", verbose=TRUE) |
11 | 11 |
} |
12 | 12 |
\arguments{ |
13 |
- \item{RG}{a numeric matrix, \code{EListRaw} or \code{\link[limma:rglist]{RGList}} object.} |
|
13 |
+ \item{RG}{a numeric matrix, \code{\link[limma:EList]{EListRaw}} or \code{\link[limma:rglist]{RGList}} object.} |
|
14 | 14 |
\item{E}{numeric matrix containing foreground intensities.} |
15 | 15 |
\item{Eb}{numeric matrix containing background intensities.} |
16 | 16 |
\item{method}{character string specifying correction method. Possible values are \code{"auto"}, \code{"none"}, \code{"subtract"}, \code{"half"}, \code{"minimum"}, \code{"movingmin"}, \code{"edwards"} or \code{"normexp"}. |
... | ... |
@@ -81,6 +81,8 @@ backgroundCorrect(RG, method="minimum") |
81 | 81 |
backgroundCorrect(RG, offset=5) |
82 | 82 |
} |
83 | 83 |
\seealso{ |
84 |
+\code{\link{kooperberg}}, \code{\link{neqc}}. |
|
85 |
+ |
|
84 | 86 |
An overview of background correction functions is given in \code{\link{04.Background}}. |
85 | 87 |
} |
86 | 88 |
\keyword{models} |
... | ... |
@@ -1,4 +1,4 @@ |
1 |
-\title{Kooperberg Model-Based Background Correction} |
|
1 |
+\title{Kooperberg Model-Based Background Correction for GenePix data} |
|
2 | 2 |
\name{kooperberg} |
3 | 3 |
\alias{kooperberg} |
4 | 4 |
\description{ |
... | ... |
@@ -40,6 +40,11 @@ the red channel for each spot for each array} |
40 | 40 |
Kooperberg, C., Fazzio, T. G., Delrow, J. J., and Tsukiyama, T. (2002) |
41 | 41 |
Improved background correction for spotted DNA microarrays. |
42 | 42 |
\emph{Journal of Computational Biology} \bold{9}, 55-66. |
43 |
+ |
|
44 |
+Ritchie, M. E., Silver, J., Oshlack, A., Silver, J., Holmes, M., Diyagama, D., Holloway, A., and Smyth, G. K. (2007). |
|
45 |
+A comparison of background correction methods for two-colour microarrays. |
|
46 |
+\emph{Bioinformatics} 23, 2700-2707. |
|
47 |
+\url{http://bioinformatics.oxfordjournals.org/cgi/content/abstract/btm412} |
|
43 | 48 |
} |
44 | 49 |
|
45 | 50 |
\seealso{ |
... | ... |
@@ -13,7 +13,7 @@ normalizeBetweenArrays(object, method=NULL, targets=NULL, ...) |
13 | 13 |
\arguments{ |
14 | 14 |
\item{object}{a numeric \code{matrix}, \code{EListRaw}, \code{\link[limma:rglist]{RGList}} or \code{\link[limma:malist]{MAList}} object.} |
15 | 15 |
\item{method}{character string specifying the normalization method to be used. |
16 |
- Choices are \code{"none"}, \code{"scale"}, \code{"quantile"}, \code{"Aquantile"}, \code{"Gquantile"}, \code{"Rquantile"}, \code{"Tquantile"} or \code{"vsn"}. |
|
16 |
+ Choices are \code{"none"}, \code{"scale"}, \code{"quantile"}, \code{"Aquantile"}, \code{"Gquantile"}, \code{"Rquantile"} or \code{"Tquantile"}. |
|
17 | 17 |
A partial string sufficient to uniquely identify the choice is permitted. |
18 | 18 |
Default is \code{"Aquantile"} for two-color data objects or \code{"quantile"} for single-channel objects.} |
19 | 19 |
\item{targets}{vector, factor or matrix of length twice the number of arrays, used to indicate target groups if \code{method="Tquantile"}} |
... | ... |
@@ -50,9 +50,6 @@ If \code{object} is a \code{matrix} then the scale, quantile or vsn normalizatio |
50 | 50 |
Applying \code{method="Aquantile"} when \code{object} is a \code{matrix} will produce an error. |
51 | 51 |
If \code{object} is an \code{EListRaw} object, then normalization will be applied to the matrix \code{object$E} of expression values, which will then be log2-transformed. |
52 | 52 |
|
53 |
-\code{method="vsn"} uses the \code{vsnMatrix} function from the vsn package. |
|
54 |
-For this option the input \code{object} should contain raw intensities, i.e., prior to background correction, log-transformation or any normalization. |
|
55 |
- |
|
56 | 53 |
See the limma User's Guide for more examples of use of this function. |
57 | 54 |
} |
58 | 55 |
|
... | ... |
@@ -60,6 +57,8 @@ See the limma User's Guide for more examples of use of this function. |
60 | 57 |
If \code{object} is a matrix then \code{normalizeBetweenArrays} produces a matrix of the same size. |
61 | 58 |
If \code{object} is an \code{EListRaw} object, then an \code{EList} object with expression values on the log2 scale is produced. |
62 | 59 |
For two-color data, \code{normalizeBetweenArrays} produces an \code{\link[limma:malist]{MAList}} object with M and A-values on the log2 scale. |
60 |
+ |
|
61 |
+Note than vsn normalization, previously offered as a method of this function, is now performed by the \code{\link{normalizeVSN}} function. |
|
63 | 62 |
} |
64 | 63 |
|
65 | 64 |
\author{Gordon Smyth} |
... | ... |
@@ -80,9 +79,8 @@ In: D. R. Goldstein (ed.), \emph{Science and Statistics: A Festschrift for Terry |
80 | 79 |
\seealso{ |
81 | 80 |
An overview of LIMMA functions for normalization is given in \link{05.Normalization}. |
82 | 81 |
|
83 |
- See also \code{\link[marray:maNormScale]{maNormScale}} in the marray package, |
|
84 |
- \code{\link[affy:normalize]{normalize}} in the affy package, |
|
85 |
- and \code{\link[vsn:vsn]{vsn}} and \code{\link[vsn:vsn2]{vsnMatrix}} in the vsn package. |
|
82 |
+ See also \code{\link[marray:maNormScale]{maNormScale}} in the marray package and |
|
83 |
+ \code{\link[affy:normalize]{normalize}} in the affy package. |
|
86 | 84 |
} |
87 | 85 |
|
88 | 86 |
\examples{ |