/R/decostand.R
http://github.com/jarioksa/vegan · R · 95 lines · 95 code · 0 blank · 0 comment · 26 complexity · d8b306f70499d950d939b0f42de6cb83 MD5 · raw file
- `decostand` <-
- function (x, method, MARGIN, range.global, logbase = 2, na.rm = FALSE, ...)
- {
- wasDataFrame <- is.data.frame(x)
- x <- as.matrix(x)
- METHODS <- c("total", "max", "frequency", "normalize", "range", "rank",
- "rrank", "standardize", "pa", "chi.square", "hellinger",
- "log")
- method <- match.arg(method, METHODS)
- if (any(x < 0, na.rm = na.rm)) {
- k <- min(x, na.rm = na.rm)
- if (method %in% c("total", "frequency", "pa", "chi.square", "rank",
- "rrank")) {
- warning("input data contains negative entries: result may be non-sense\n")
- }
- }
- else k <- .Machine$double.eps
- switch(method, total = {
- if (missing(MARGIN))
- MARGIN <- 1
- tmp <- pmax(k, apply(x, MARGIN, sum, na.rm = na.rm))
- x <- sweep(x, MARGIN, tmp, "/")
- }, max = {
- if (missing(MARGIN))
- MARGIN <- 2
- tmp <- pmax(k, apply(x, MARGIN, max, na.rm = na.rm))
- x <- sweep(x, MARGIN, tmp, "/")
- }, frequency = {
- if (missing(MARGIN))
- MARGIN <- 2
- tmp <- pmax(k, apply(x, MARGIN, sum, na.rm = na.rm))
- fre <- apply(x > 0, MARGIN, sum, na.rm = na.rm)
- tmp <- fre/tmp
- x <- sweep(x, MARGIN, tmp, "*")
- }, normalize = {
- if (missing(MARGIN))
- MARGIN <- 1
- tmp <- apply(x^2, MARGIN, sum, na.rm = na.rm)
- tmp <- pmax(.Machine$double.eps, sqrt(tmp))
- x <- sweep(x, MARGIN, tmp, "/")
- }, range = {
- if (missing(MARGIN))
- MARGIN <- 2
- if (missing(range.global))
- xtmp <- x
- else {
- if (dim(range.global)[MARGIN] != dim(x)[MARGIN])
- stop("range matrix does not match data matrix")
- xtmp <- as.matrix(range.global)
- }
- tmp <- apply(xtmp, MARGIN, min, na.rm = na.rm)
- ran <- apply(xtmp, MARGIN, max, na.rm = na.rm)
- ran <- ran - tmp
- ran <- pmax(k, ran, na.rm = na.rm)
- x <- sweep(x, MARGIN, tmp, "-")
- x <- sweep(x, MARGIN, ran, "/")
- }, rank = {
- if (missing(MARGIN)) MARGIN <- 1
- x[x==0] <- NA
- x <- apply(x, MARGIN, rank, na.last = "keep")
- if (MARGIN == 1) # gives transposed x
- x <- t(x)
- x[is.na(x)] <- 0
- }, rrank = {
- if (missing(MARGIN)) MARGIN <- 1
- x <- decostand(x, "rank", MARGIN = MARGIN)
- x <- sweep(x, MARGIN, specnumber(x, MARGIN = MARGIN), "/")
- }, standardize = {
- if (!missing(MARGIN) && MARGIN == 1)
- x <- t(scale(t(x)))
- else x <- scale(x)
- }, pa = {
- x <- ifelse(x > 0, 1, 0)
- }, chi.square = {
- if (!missing(MARGIN) && MARGIN == 2)
- x <- t(x)
- x <- sqrt(sum(x, na.rm = na.rm)) * x/outer(pmax(k, rowSums(x,
- na.rm = na.rm)), sqrt(colSums(x, na.rm = na.rm)))
- }, hellinger = {
- x <- sqrt(decostand(x, "total", MARGIN = MARGIN, na.rm = na.rm))
- }, log = {### Marti Anderson logs, after Etienne Laliberte
- if (!isTRUE(all.equal(as.integer(x), as.vector(x)))) {
- x <- x / min(x[x > 0], na.rm = TRUE)
- warning("non-integer data: divided by smallest positive value",
- call. = FALSE)
- }
- x[x > 0 & !is.na(x)] <- log(x[x > 0 & !is.na(x)], base = logbase) + 1
- })
- if (any(is.nan(x)))
- warning("result contains NaN, perhaps due to impossible mathematical operation\n")
- if (wasDataFrame)
- x <- as.data.frame(x)
- attr(x, "decostand") <- method
- x
- }