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]
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ý (zeleny@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ý (zeleny@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.txt · Last modified: 2019/06/27 11:37 by David Zelený