matrixBlockPolish.matrix {aroma.core} | R Documentation |
Applies a polishing function to blocks of rows and columns repeatedly.
## S3 method for class 'matrix': matrixBlockPolish(z, x=NULL, blockSizes=c(1, 1), FUN, ..., tol=0.01, maxIter=10, returnEffects=FALSE)
z |
A numeric KxN matrix . |
x |
A optional KxNx2 array (or KxN matrix ). |
blockSizes |
A positive integer vector of length two. |
FUN |
A function taking numeric arguments z and
x and returns a numeric object with either a scalar
or the same number of elements as in z . |
... |
Additional arguments passed to the FUN function . |
tol |
A positive threshold specifying when the algorithm has converged. |
maxIter |
The maximum number of iterations. |
returnEffects |
If TRUE , the row and column effects are returned,
otherwise not. |
Returns a named list
.
Henrik Bengtsson (http://www.braju.com/R/)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 1: median polish # From example(medpolish) in the 'stats' package # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Deaths from sport parachuting; from ABC of EDA, p.224: deaths <- matrix(c(14,15,14, 7,4,7, 8,2,10, 15,9,10, 0,2,0), ncol=3, byrow=TRUE) rownames(deaths) <- c("1-24", "25-74", "75-199", "200++", "NA") colnames(deaths) <- 1973:1975 print(deaths) fit1 <- medpolish(deaths, trace=FALSE) r1 <- residuals(fit1) fit2 <- matrixBlockPolish(deaths, FUN=function(y, x, ...) median(y, ...)) r2 <- residuals(fit2) stopifnot(all.equal(r1,r2)) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Example 2: smooth spline polish ("spatial smoothing") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # From example(image) in 'graphics' package x <- y <- seq(-4*pi, 4*pi, len=27) r <- sqrt(outer(x^2, y^2, FUN="+")) z <- cos(r^2) * exp(-r/6) fit <- matrixBlockPolish(z, FUN=function(z, x, ...) median(z, ...), returnEffects=TRUE) r1 <- residuals(fit) fit <- matrixBlockPolish(z, FUN=function(z, x, ...) { fit <- smooth.spline(x=x, y=z, ...); predict(fit, x=x)$y; }, spar=0.25) r2 <- residuals(fit) print(range(r2)) image(r2)