User Tools

Site Tools


en:customized_functions:envfit.iv

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
en:customized_functions:envfit.iv [2017/10/11 20:36]
127.0.0.1 external edit
en:customized_functions:envfit.iv [2019/06/27 11:37] (current)
David Zelený
Line 2: Line 2:
 Reference: Zelený & Schafers (2012) Reference: Zelený & Schafers (2012)
  
 +
 +~~NOTOC~~
  
 ====== envfit.iv ====== ====== envfit.iv ======
-Appendix S2 of the paper Zelený & Schaffers (2012) – Function for projection of mean Ellenberg indicator values onto an ordination, with modified permutation test+Appendix S2 of the paper Zelený & Schaffers (2012) – Function for projection of mean Ellenberg indicator values onto an ordination, with modified permutation test.
  
 +**Note: this function has been included in the package ''​[[https://​github.com/​zdealveindy/​weimea|weimea]]''​ as ''​envfit_cwm'',​ with improved functionality. Consider installing ''​weimea''​ and trying it!
 +**
 ===== Description ===== ===== Description =====
  
Line 41: Line 45:
 ===== Author(s) ===== ===== Author(s) =====
  
-David Zelený ([email protected]sci.muni.cz); the script is almost entirely based on the original functions ''​envfit'' ​ and ''​vectorfit''​ from ''​vegan''​ package, written by Jari Oksanen.+David Zelený ([email protected]ntu.edu.tw); the script is almost entirely based on the original functions ''​envfit''​ and ''​vectorfit''​ from ''​vegan''​ package, written by Jari Oksanen. Update to the function ''​envfit.iv''​ for latest version of ''​vegan''​ was provided by Sebastian Utermann.
  
 ===== See Also ===== ===== See Also =====
  
-''​envfit'',​ ''​vectorfit'' ​ and ''​plot.envfit''​ from library ''​vegan''​+''​envfit'',​ ''​vectorfit''​ and ''​plot.envfit''​ from library ''​vegan''​
  
 ===== Examples ===== ===== Examples =====
Line 102: Line 106:
 plot (fit.modif, p.max = 0.05, col = '​red'​) plot (fit.modif, p.max = 0.05, col = '​red'​)
 </​code>​ </​code>​
-===== Definition of the function ===== + 
-<file rsplus ​envfit.iv.r>​+===== Definition of the function ​(version updated on 6/2019 by Sebastian Utermann) ​===== 
 +<code> 
 +envfit.iv ​<- function (ord, veg, spec.iv, permutations = 999, choices = c(1, 2), display = "​sites",​ w = weights(ord),​ na.rm = FALSE, ...) 
 +
 +  weights.default <- function(object,​ ...) NULL 
 +  vectorfit.iv <- 
 +    function (X, veg, spec.iv, permutations,​ w, ...)  
 +  { 
 +    apply.FUN <- function (x)  
 +    { 
 +      veg.temp <- veg [,!is.na (x)] 
 +      x.temp <- x[!is.na (x)] 
 +      colSums (t(veg.temp)*x.temp)/​rowSums (veg.temp) 
 +    } 
 +     
 +    apply.FUN.sample <- function (x)  
 +    { 
 +      veg.temp <- veg [,!is.na (x)] 
 +      x.temp <- x[!is.na (x)] 
 +      colSums (t(veg.temp)*sample (x.temp))/​rowSums (veg.temp) 
 +    } 
 +     
 +    P <- apply (spec.iv, 2, FUN = apply.FUN) 
 +    X <- as.matrix(X) 
 +    if (missing(w) || is.null(w))  
 +      w <- 1 
 +    if (length(w) == 1)  
 +      w <- rep(w, nrow(X)) 
 +    Xw <- .Call("​do_wcentre",​ X, w) 
 +    dim(Xw) <- dim(X) 
 +    Pw <- .Call("​do_wcentre",​ P, w) 
 +    dim(Pw) <- dim(P) 
 +    colnames(Pw) <- colnames(P) 
 +    nc <- ncol(X) 
 +    Q <- qr(Xw) 
 +    H <- qr.fitted(Q,​ Pw) 
 +    heads <- qr.coef(Q, Pw) 
 +    ​<- diag(cor(H, Pw)^2) 
 +    heads <- decostand(heads,​ "​norm",​ 2) 
 +    heads <- t(heads) 
 +    if (is.null(colnames(X)))  
 +      colnames(heads) <- paste("​Dim",​ 1:nc, sep = ""​) 
 +    else colnames(heads) <- colnames(X) 
 +    if (permutations) { 
 +      nr <- nrow(X) 
 +      permstore <- matrix(nrow = permutations,​ ncol = ncol(P)) 
 +      for (i in 1:​permutations) { 
 +        take <- apply (spec.iv, 2, FUN = apply.FUN.sample) 
 +        take <- .Call("​do_wcentre",​ take, w) 
 +        dim(take) <- dim(P) 
 +        Hperm <- qr.fitted(Q,​ take) 
 +        permstore[i,​ ] <- diag(cor(Hperm,​ take))^2 
 +      } 
 +      permstore <- sweep(permstore,​ 2, r, ">"​) 
 +      pvals <- (apply(permstore,​ 2, sum) + 1)/​(permutations +  
 +                                                 1) 
 +    } 
 +    else pvals <- NULL 
 +    sol <- list(arrows = heads, r = r, permutations = permutations,​  
 +                pvals = pvals) 
 +    class(sol) <- "​vectorfit"​ 
 +    sol 
 +    } 
 + 
 +    w <- eval(w) 
 +    vectors <- NULL 
 +    factors <- NULL 
 +    seed <- NULL 
 +    X <- scores(ord, display = display, choices = choices, ...) 
 +    keep <- complete.cases(X) 
 +    if (any(!keep)) { 
 +        if (!na.rm)  
 +            stop("​missing values in data: consider na.rm = TRUE"​) 
 +        X <- X[keep, , drop = FALSE] 
 +        na.action <- structure(seq_along(keep)[!keep],​ class = "​omit"​) 
 +    } 
 +    vectors <- vectorfit.iv(X,​ veg, spec.iv, permutations,​ choices, 
 +        w = w, ...) 
 +    sol <- list(vectors = vectors, factors = factors) 
 +    if (!is.null(na.action))  
 +        sol$na.action <- na.action 
 +    class(sol) <- "​envfit"​ 
 +    sol 
 +
 +</​code>​ 
 +Definition of the function (original version published in Zelený & Scheffers 2012) 
 +<code>
 envfit.iv <- function (ord, veg, spec.iv, permutations = 999, choices = c(1, 2), display = "​sites",​ w = weights(ord),​ na.rm = FALSE, ...) envfit.iv <- function (ord, veg, spec.iv, permutations = 999, choices = c(1, 2), display = "​sites",​ w = weights(ord),​ na.rm = FALSE, ...)
 { {
Line 189: Line 279:
     sol     sol
 } }
-</file> +</code>
  
en/customized_functions/envfit.iv.1507725374.txt.gz · Last modified: 2017/10/11 20:36 by 127.0.0.1