/R/decostand.R

http://github.com/jarioksa/vegan · R · 95 lines · 95 code · 0 blank · 0 comment · 26 complexity · d8b306f70499d950d939b0f42de6cb83 MD5 · raw file

  1. `decostand` <-
  2. function (x, method, MARGIN, range.global, logbase = 2, na.rm = FALSE, ...)
  3. {
  4. wasDataFrame <- is.data.frame(x)
  5. x <- as.matrix(x)
  6. METHODS <- c("total", "max", "frequency", "normalize", "range", "rank",
  7. "rrank", "standardize", "pa", "chi.square", "hellinger",
  8. "log")
  9. method <- match.arg(method, METHODS)
  10. if (any(x < 0, na.rm = na.rm)) {
  11. k <- min(x, na.rm = na.rm)
  12. if (method %in% c("total", "frequency", "pa", "chi.square", "rank",
  13. "rrank")) {
  14. warning("input data contains negative entries: result may be non-sense\n")
  15. }
  16. }
  17. else k <- .Machine$double.eps
  18. switch(method, total = {
  19. if (missing(MARGIN))
  20. MARGIN <- 1
  21. tmp <- pmax(k, apply(x, MARGIN, sum, na.rm = na.rm))
  22. x <- sweep(x, MARGIN, tmp, "/")
  23. }, max = {
  24. if (missing(MARGIN))
  25. MARGIN <- 2
  26. tmp <- pmax(k, apply(x, MARGIN, max, na.rm = na.rm))
  27. x <- sweep(x, MARGIN, tmp, "/")
  28. }, frequency = {
  29. if (missing(MARGIN))
  30. MARGIN <- 2
  31. tmp <- pmax(k, apply(x, MARGIN, sum, na.rm = na.rm))
  32. fre <- apply(x > 0, MARGIN, sum, na.rm = na.rm)
  33. tmp <- fre/tmp
  34. x <- sweep(x, MARGIN, tmp, "*")
  35. }, normalize = {
  36. if (missing(MARGIN))
  37. MARGIN <- 1
  38. tmp <- apply(x^2, MARGIN, sum, na.rm = na.rm)
  39. tmp <- pmax(.Machine$double.eps, sqrt(tmp))
  40. x <- sweep(x, MARGIN, tmp, "/")
  41. }, range = {
  42. if (missing(MARGIN))
  43. MARGIN <- 2
  44. if (missing(range.global))
  45. xtmp <- x
  46. else {
  47. if (dim(range.global)[MARGIN] != dim(x)[MARGIN])
  48. stop("range matrix does not match data matrix")
  49. xtmp <- as.matrix(range.global)
  50. }
  51. tmp <- apply(xtmp, MARGIN, min, na.rm = na.rm)
  52. ran <- apply(xtmp, MARGIN, max, na.rm = na.rm)
  53. ran <- ran - tmp
  54. ran <- pmax(k, ran, na.rm = na.rm)
  55. x <- sweep(x, MARGIN, tmp, "-")
  56. x <- sweep(x, MARGIN, ran, "/")
  57. }, rank = {
  58. if (missing(MARGIN)) MARGIN <- 1
  59. x[x==0] <- NA
  60. x <- apply(x, MARGIN, rank, na.last = "keep")
  61. if (MARGIN == 1) # gives transposed x
  62. x <- t(x)
  63. x[is.na(x)] <- 0
  64. }, rrank = {
  65. if (missing(MARGIN)) MARGIN <- 1
  66. x <- decostand(x, "rank", MARGIN = MARGIN)
  67. x <- sweep(x, MARGIN, specnumber(x, MARGIN = MARGIN), "/")
  68. }, standardize = {
  69. if (!missing(MARGIN) && MARGIN == 1)
  70. x <- t(scale(t(x)))
  71. else x <- scale(x)
  72. }, pa = {
  73. x <- ifelse(x > 0, 1, 0)
  74. }, chi.square = {
  75. if (!missing(MARGIN) && MARGIN == 2)
  76. x <- t(x)
  77. x <- sqrt(sum(x, na.rm = na.rm)) * x/outer(pmax(k, rowSums(x,
  78. na.rm = na.rm)), sqrt(colSums(x, na.rm = na.rm)))
  79. }, hellinger = {
  80. x <- sqrt(decostand(x, "total", MARGIN = MARGIN, na.rm = na.rm))
  81. }, log = {### Marti Anderson logs, after Etienne Laliberte
  82. if (!isTRUE(all.equal(as.integer(x), as.vector(x)))) {
  83. x <- x / min(x[x > 0], na.rm = TRUE)
  84. warning("non-integer data: divided by smallest positive value",
  85. call. = FALSE)
  86. }
  87. x[x > 0 & !is.na(x)] <- log(x[x > 0 & !is.na(x)], base = logbase) + 1
  88. })
  89. if (any(is.nan(x)))
  90. warning("result contains NaN, perhaps due to impossible mathematical operation\n")
  91. if (wasDataFrame)
  92. x <- as.data.frame(x)
  93. attr(x, "decostand") <- method
  94. x
  95. }