[Vegan-commits] r2227 - in pkg/vegan: R inst

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Jul 7 16:30:28 CEST 2012


Author: jarioksa
Date: 2012-07-07 16:30:28 +0200 (Sat, 07 Jul 2012)
New Revision: 2227

Modified:
   pkg/vegan/R/adipart.default.R
   pkg/vegan/R/adipart.formula.R
   pkg/vegan/R/hiersimu.default.R
   pkg/vegan/R/hiersimu.formula.R
   pkg/vegan/R/multipart.default.R
   pkg/vegan/R/multipart.formula.R
   pkg/vegan/inst/ChangeLog
Log:
Squashed commit of the following:

commit 8e85f93aa889667bd8c45c6ada5bc8db8a51a43a
Merge: 9e483e4 f636a9a
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 17:24:26 2012 +0300

    Merge branch 'master' of https://github.com/jarioksa/vegan

    Conflicts:
    	inst/ChangeLog

commit f636a9a7f6104d14573b0ff946ec4a71b8bdcc01
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 16:57:28 2012 +0300

    Merge branches 'oecosimoids' and 'master'

commit 1e1d0ca23076fa78b10b227b75c6de38d9e77250
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 13:47:48 2012 +0300

    ChangeLog about formula/call attr changes in adipart, multipart, hiersimu

commit 54c90218ca1261a907880906f585c88b6c196e3a
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 13:42:24 2012 +0300

    formula method returns its own (generic) call in adipart & hiersimu

    The "call" attribute was always set by the default method, and
    therefore the internal call was returned from the formula method
    instead of the user call.

commit a4e404f7575e745091d8fd8e0c80f5fd68104dab
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 13:31:50 2012 +0300

    use generic multipart() for saved call

commit 9de0572bcd201e5e8a0e49aaa47c3a0ec668f457
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 13:26:50 2012 +0300

    more canonical multipart.formula()

commit 77b20900034ae93979d02ac96e0b78c293b72125
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 13:15:54 2012 +0300

    more canonical implementation of hiersimu.formula

    hiersimu.formula() only interprets formula and calls hiersimu.default()
    without duplicating its code.

commit 5b78a8c206c2028456310c626d1635a8cb39afe1
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 12:40:42 2012 +0300

    more canonical way of writing adipart.formula (also fixes match.call name)

    Function adipart.formula() duplicated the full analysis of adipart.default.
    The only difference was the interpretation of the input data. Now
    adipart.formula() only interprets the formula and then calls
    adipart.default() with the interpreted matrices.

    This is also a maintenance issue: now things need be fixed only in
    one file, and the methods do not randomly drift apart.

    This also means that now the "call" from match.call() is always
    set by adipart.default and will be generic adipart() instead of
    adipart.formula().

commit 3ec7998fb8f595f86fffa41fdc0c596c28f6300c
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Sat Jul 7 12:37:37 2012 +0300

    the saved call of adipart uses now the generic name instead of full method name

    adipart.formula and adipart.default each saved the call as given by
    match.call(), and the function was either called adipart.default()
    or adipart.formula. Now it is always generic adipart.

    For the full force, this also needs the next commit that changes
    adipart.formula.

Modified: pkg/vegan/R/adipart.default.R
===================================================================
--- pkg/vegan/R/adipart.default.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/adipart.default.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -98,7 +98,9 @@
     nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
              paste("beta", 1:(nlevs-1), sep="."))
     names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
-    attr(sim, "call") <- match.call()
+    call <- match.call()
+    call[[1]] <- as.name("adipart")
+    attr(sim, "call") <- call
     attr(sim, "index") <- index
     attr(sim, "weights") <- weights
     attr(sim, "n.levels") <- nlevs

Modified: pkg/vegan/R/adipart.formula.R
===================================================================
--- pkg/vegan/R/adipart.formula.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/adipart.formula.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -1,6 +1,6 @@
-adipart.formula <-
-function(formula, data, index=c("richness", "shannon", "simpson"),
-    weights=c("unif", "prop"), relative = FALSE, nsimul=99, ...)
+`adipart.formula` <-
+    function(formula, data, index=c("richness", "shannon", "simpson"),
+             weights=c("unif", "prop"), relative = FALSE, nsimul=99, ...)
 {
     ## evaluate formula
     lhs <- formula[[2]]
@@ -9,14 +9,6 @@
     lhs <- as.matrix(eval(lhs, data))
     formula[[2]] <- NULL
     rhs <- model.frame(formula, data, drop.unused.levels = TRUE)
-    tlab <- attr(attr(rhs, "terms"), "term.labels")
-    nlevs <- length(tlab)
-    if (nlevs < 2)
-        stop("provide at least two level hierarchy")
-    if (any(rowSums(lhs) == 0))
-        stop("data matrix contains empty rows")
-    if (any(lhs < 0))
-        stop("data matrix contains negative entries")
 
     ## part check proper design of the model frame
     noint <- attr(attr(attr(rhs, "terms"), "factors"), "dimnames")[[1]]
@@ -25,89 +17,10 @@
         stop("interactions are not allowed in formula")
     if (!all(attr(attr(rhs, "terms"), "dataClasses") == "factor"))
         stop("all right hand side variables in formula must be factors")
-    l1 <- sapply(rhs, function(z) length(unique(z)))
-    if (!any(sapply(2:nlevs, function(z) l1[z] <= l1[z-1])))
-        stop("number of levels are inapropriate, check sequence")
-    rval <- list()
-    rval[[1]] <- as.factor(rhs[,nlevs])
-    rval[[1]] <- rval[[1]][drop = TRUE]
-    nCol <- nlevs - 1
-    for (i in 2:nlevs) {
-        rval[[i]] <- interaction(rhs[,nCol], rval[[(i-1)]], drop=TRUE)
-        nCol <- nCol - 1
-    }
-    rval <- as.data.frame(rval[rev(1:length(rval))])
-    l2 <- sapply(rval, function(z) length(unique(z)))
-    if (any(l1 != l2))
-        warning("levels are not perfectly nested")
-
-    ## aggregate response matrix
-    fullgamma <-if (nlevels(rhs[,nlevs]) == 1)
-        TRUE else FALSE
-    ftmp <- vector("list", nlevs)
-    for (i in 1:nlevs) {
-        ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
-    }
-
-    ## is there a method/burnin/thin in ... ?
-    method <- if (is.null(list(...)$method))
-        "r2dtable" else list(...)$method
-    burnin <- if (is.null(list(...)$burnin))
-        0 else list(...)$burnin
-    thin <- if (is.null(list(...)$thin))
-        1 else list(...)$thin
-    base <- if (is.null(list(...)$base))
-        exp(1) else list(...)$base
-
-    ## evaluate other arguments
-    index <- match.arg(index)
-    weights <- match.arg(weights)
-    switch(index,
-           "richness" = {
-               divfun <- function(x) apply(x > 0, 1, sum)},
-           "shannon" = {
-               divfun <- function(x) diversity(x, index = "shannon", MARGIN = 1, base=base)},
-           "simpson" = {
-               divfun <- function(x) diversity(x, index = "simpson", MARGIN = 1)})
-
-    ## this is the function passed to oecosimu
-    wdivfun <- function(x) {
-        ## matrix sum *can* change in oecosimu (but default is constant sumMatr)
-        sumMatr <- sum(x)
-        if (fullgamma) {
-            tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-            tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
-        } else {
-            tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-        }
-        ## weights will change in oecosimu thus need to be recalculated
-        if (weights == "prop")
-            wt <- lapply(1:nlevs, function(i) apply(tmp[[i]], 1, function(z) sum(z) / sumMatr))
-        else wt <- lapply(1:nlevs, function(i) rep(1 / NROW(tmp[[i]]), NROW(tmp[[i]])))
-        a <- sapply(1:nlevs, function(i) sum(divfun(tmp[[i]]) * wt[[i]]))
-        if (relative)
-            a <- a / a[length(a)]
-        b <- sapply(2:nlevs, function(i) a[i] - a[(i-1)])
-        c(a, b)
-    }
-    if (nsimul > 0) {
-        sim <- oecosimu(lhs, wdivfun, method = method, nsimul=nsimul,
-                        burnin=burnin, thin=thin)
-    } else {
-        sim <- wdivfun(lhs)
-        tmp <- rep(NA, length(sim))
-        sim <- list(statistic = sim,
-                    oecosimu = list(z = tmp, pval = tmp, method = NA, statistic = sim))
-    }
-    nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
-             paste("beta", 1:(nlevs-1), sep="."))
-    names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
-    attr(sim, "call") <- match.call()
-    attr(sim, "index") <- index
-    attr(sim, "weights") <- weights
-    attr(sim, "n.levels") <- nlevs
-    attr(sim, "terms") <- tlab
-    attr(sim, "model") <- rhs
-    class(sim) <- c("adipart", "list")
+    sim <- adipart.default(lhs, rhs, index = index, weights = weights,
+                           relative = relative, nsimul = nsimul, ...)
+    call <- match.call()
+    call[[1]] <- as.name("adipart")
+    attr(sim, "call") <- call
     sim
 }

Modified: pkg/vegan/R/hiersimu.default.R
===================================================================
--- pkg/vegan/R/hiersimu.default.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/hiersimu.default.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -82,7 +82,9 @@
 #    nam <- paste("level", 1:nlevs, sep=".")
 #    names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
     names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- tlab[1:nlevs]
-    attr(sim, "call") <- match.call()
+    call <- match.call()
+    call[[1]] <- as.name("hiersimu")
+    attr(sim, "call") <- call
     attr(sim, "FUN") <- FUN
     attr(sim, "location") <- location
     attr(sim, "n.levels") <- nlevs

Modified: pkg/vegan/R/hiersimu.formula.R
===================================================================
--- pkg/vegan/R/hiersimu.formula.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/hiersimu.formula.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -1,6 +1,6 @@
-hiersimu.formula <-
-function(formula, data, FUN, location = c("mean", "median"),
-relative = FALSE, drop.highest = FALSE, nsimul=99, ...)
+`hiersimu.formula` <-
+    function(formula, data, FUN, location = c("mean", "median"),
+             relative = FALSE, drop.highest = FALSE, nsimul=99, ...)
 {
     ## evaluate formula
     lhs <- formula[[2]]
@@ -9,8 +9,6 @@
     lhs <- as.matrix(eval(lhs, data))
     formula[[2]] <- NULL
     rhs <- model.frame(formula, data, drop.unused.levels = TRUE)
-    tlab <- attr(attr(rhs, "terms"), "term.labels")
-    nlevs <- length(tlab)
 
     ## part check proper design of the model frame
     noint <- attr(attr(attr(rhs, "terms"), "factors"), "dimnames")[[1]]
@@ -19,78 +17,11 @@
         stop("interactions are not allowed in formula")
     if (!all(attr(attr(rhs, "terms"), "dataClasses") == "factor"))
         stop("all right hand side variables in formula must be factors")
-    l1 <- sapply(rhs, function(z) length(unique(z)))
-    if (nlevs > 1 && !any(sapply(2:nlevs, function(z) l1[z] <= l1[z-1])))
-        stop("number of levels are inapropriate, check sequence")
-    rval <- list()
-    rval[[1]] <- as.factor(rhs[,nlevs])
-    rval[[1]] <- rval[[1]][drop = TRUE]
-    if (nlevs > 1) {
-        nCol <- nlevs - 1
-        for (i in 2:nlevs) {
-            rval[[i]] <- interaction(rhs[,nCol], rval[[(i-1)]], drop=TRUE)
-            nCol <- nCol - 1
-        }
-    }
-    rval <- as.data.frame(rval[rev(1:length(rval))])
-    l2 <- sapply(rval, function(z) length(unique(z)))
-    if (any(l1 != l2))
-        warning("levels are not perfectly nested")
-
-    ## aggregate response matrix
-    fullgamma <-if (nlevels(rhs[,nlevs]) == 1)
-        TRUE else FALSE
-    if (fullgamma && drop.highest)
-        nlevs <- nlevs - 1
-    if (nlevs == 1 && relative)
-        stop("'relative=FALSE' makes no sense with 1 level")
-    ftmp <- vector("list", nlevs)
-    for (i in 1:nlevs) {
-        ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
-    }
-
-    ## is there a method/burnin/thin in ... ?
-    method <- if (is.null(list(...)$method))
-        "r2dtable" else list(...)$method
-    burnin <- if (is.null(list(...)$burnin))
-        0 else list(...)$burnin
-    thin <- if (is.null(list(...)$thin))
-        1 else list(...)$thin
-
-    ## evaluate other arguments
-    if (!is.function(FUN))
-        stop("'FUN' must be a function")
-    location <- match.arg(location)
-    aggrFUN <- switch(location,
-        "mean" = mean,
-        "median" = median)
-
-    ## this is the function passed to oecosimu
-    evalFUN <- function(x) {
-        if (fullgamma && !drop.highest) {
-            tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-            tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
-        } else {
-            tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-        }
-        a <- sapply(1:nlevs, function(i) aggrFUN(FUN(tmp[[i]]))) # dots removed from FUN
-        if (relative)
-            a <- a / a[length(a)]
-        a
-    }
-
-    ## processing oecosimu results
-    sim <- oecosimu(lhs, evalFUN, method = method, nsimul=nsimul,
-        burnin=burnin, thin=thin)
-#    nam <- paste("level", 1:nlevs, sep=".")
-#    names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
-    names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- tlab[1:nlevs]
-    attr(sim, "call") <- match.call()
-    attr(sim, "FUN") <- FUN
-    attr(sim, "location") <- location
-    attr(sim, "n.levels") <- nlevs
-    attr(sim, "terms") <- tlab
-    attr(sim, "model") <- rhs
-    class(sim) <- c("hiersimu", "list")
+    sim <- hiersimu.default(lhs, rhs, FUN = FUN, location = location,
+                            relative = relative, drop.highest = drop.highest,
+                            nsimul = nsimul, ...)
+    call <- match.call()
+    call[[1]] <- as.name("hiersimu")
+    attr(sim, "call") <- call
     sim
 }

Modified: pkg/vegan/R/multipart.default.R
===================================================================
--- pkg/vegan/R/multipart.default.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/multipart.default.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -1,6 +1,6 @@
-multipart.default <-
-function(y, x, index=c("renyi", "tsallis"), scales = 1,
-    global = FALSE, relative = FALSE, nsimul=99, ...)
+`multipart.default` <-
+    function(y, x, index=c("renyi", "tsallis"), scales = 1,
+             global = FALSE, relative = FALSE, nsimul=99, ...)
 {
     if (length(scales) > 1)
         stop("length of 'scales' must be 1")
@@ -123,7 +123,9 @@
     nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
         paste("beta", 1:(nlevs-1), sep="."))
     names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
-    attr(sim, "call") <- match.call()
+    call <- match.call()
+    call[[1]] <- as.name("multipart")
+    attr(sim, "call") <- call
     attr(sim, "index") <- index
     attr(sim, "scales") <- scales
     attr(sim, "global") <- TRUE

Modified: pkg/vegan/R/multipart.formula.R
===================================================================
--- pkg/vegan/R/multipart.formula.R	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/R/multipart.formula.R	2012-07-07 14:30:28 UTC (rev 2227)
@@ -1,9 +1,7 @@
-multipart.formula <-
-function(formula, data, index=c("renyi", "tsallis"), scales = 1,
-    global = FALSE, relative = FALSE, nsimul=99, ...)
+`multipart.formula` <-
+    function(formula, data, index=c("renyi", "tsallis"), scales = 1,
+             global = FALSE, relative = FALSE, nsimul=99, ...)
 {
-    if (length(scales) > 1)
-        stop("length of 'scales' must be 1")
     ## evaluate formula
     lhs <- formula[[2]]
     if (missing(data))
@@ -11,14 +9,6 @@
     lhs <- as.matrix(eval(lhs, data))
     formula[[2]] <- NULL
     rhs <- model.frame(formula, data, drop.unused.levels = TRUE)
-    tlab <- attr(attr(rhs, "terms"), "term.labels")
-    nlevs <- length(tlab)
-    if (nlevs < 2)
-        stop("provide at least two level hierarchy")
-    if (any(rowSums(lhs) == 0))
-        stop("data matrix contains empty rows")
-    if (any(lhs < 0))
-        stop("data matrix contains negative entries")
 
     ## part check proper design of the model frame
     noint <- attr(attr(attr(rhs, "terms"), "factors"), "dimnames")[[1]]
@@ -27,113 +17,11 @@
         stop("interactions are not allowed in formula")
     if (!all(attr(attr(rhs, "terms"), "dataClasses") == "factor"))
         stop("all right hand side variables in formula must be factors")
-    l1 <- sapply(rhs, function(z) length(unique(z)))
-    if (!any(sapply(2:nlevs, function(z) l1[z] <= l1[z-1])))
-        stop("number of levels are inapropriate, check sequence")
-    rval <- list()
-    rval[[1]] <- as.factor(rhs[,nlevs])
-    rval[[1]] <- rval[[1]][drop = TRUE]
-    nCol <- nlevs - 1
-    for (i in 2:nlevs) {
-        rval[[i]] <- interaction(rhs[,nCol], rval[[(i-1)]], drop=TRUE)
-        nCol <- nCol - 1
-    }
-    rval <- as.data.frame(rval[rev(1:length(rval))])
-    l2 <- sapply(rval, function(z) length(unique(z)))
-    if (any(l1 != l2))
-        warning("levels are not perfectly nested")
-
-    ## aggregate response matrix
-    fullgamma <-if (nlevels(rhs[,nlevs]) == 1)
-        TRUE else FALSE
-#    if (!fullgamma && !global)
-#        warning("gamma diversity value might be meaningless")
-    ftmp <- vector("list", nlevs)
-    for (i in 1:nlevs) {
-        ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
-    }
-
-    ## is there a method/burnin/thin in ... ?
-    method <- if (is.null(list(...)$method))
-        "r2dtable" else list(...)$method
-    burnin <- if (is.null(list(...)$burnin))
-        0 else list(...)$burnin
-    thin <- if (is.null(list(...)$thin))
-        1 else list(...)$thin
-
-    ## evaluate other arguments
-    index <- match.arg(index)
-    divfun <- switch(index,
-        "renyi" = function(x) renyi(x, scales=scales, hill = TRUE),
-        "tsallis" = function(x) tsallis(x, scales=scales, hill = TRUE))
-
-    ## cluster membership determination
-    nrhs <- rhs
-    nrhs <- sapply(nrhs, as.numeric)
-    idcl <- function(i) {
-        h <- nrhs[,i]
-        l <- nrhs[,(i-1)]
-        sapply(unique(l), function(i) h[l==i][1])
-    }
-    id <- lapply(2:nlevs, idcl)
-
-    ## this is the function passed to oecosimu
-    if (global) {
-        wdivfun <- function(x) {
-            if (fullgamma) {
-                tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-                tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
-            } else {
-                tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-            }
-            raw <- sapply(1:nlevs, function(i) divfun(tmp[[i]]))
-            a <- sapply(raw, mean)
-            G <- a[nlevs]
-            b <- sapply(1:(nlevs-1), function(i) G / a[i])
-            if (relative)
-                b <- b / sapply(raw[1:(nlevs-1)], length)
-            c(a, b)
-        }
-    } else {
-        wdivfun <- function(x) {
-            if (fullgamma) {
-                tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-                tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
-            } else {
-                tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
-            }
-            a <- sapply(1:nlevs, function(i) divfun(tmp[[i]]))
-            am <- lapply(1:(nlevs-1), function(i) {
-                    sapply(1:length(unique(id[[i]])), function(ii) {
-                        mean(a[[i]][id[[i]]==ii])
-                    })
-                })
-            b <- lapply(1:(nlevs-1), function(i) a[[(i+1)]] / am[[i]])
-            bmax <- lapply(id, function(i) table(i))
-            if (relative)
-                b <- lapply(1:(nlevs-1), function(i) b[[i]] / bmax[[i]])
-            c(sapply(a, mean), sapply(b, mean))
-        }
-    }
-    if (nsimul > 0) {
-            sim <- oecosimu(lhs, wdivfun, method = method, nsimul=nsimul,
-                burnin=burnin, thin=thin)
-        } else {
-            sim <- wdivfun(lhs)
-            tmp <- rep(NA, length(sim))
-            sim <- list(statistic = sim,
-                oecosimu = list(z = tmp, pval = tmp, method = NA, statistic = sim))
-        }
-    nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
-        paste("beta", 1:(nlevs-1), sep="."))
-    names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
-    attr(sim, "call") <- match.call()
-    attr(sim, "index") <- index
-    attr(sim, "scales") <- scales
-    attr(sim, "global") <- TRUE
-    attr(sim, "n.levels") <- nlevs
-    attr(sim, "terms") <- tlab
-    attr(sim, "model") <- rhs
-    class(sim) <- c("multipart", "list")
+    sim <- multipart.default(lhs, rhs, index = index, scales = scales,
+                             global = global, relative = relative,
+                             nsimul = nsimul, ...)
+    call <- match.call()
+    call[[1]] <- as.name("multipart")
+    attr(sim, "call") <- call
     sim
 }

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2012-07-07 14:16:47 UTC (rev 2226)
+++ pkg/vegan/inst/ChangeLog	2012-07-07 14:30:28 UTC (rev 2227)
@@ -9,6 +9,14 @@
 
 	* biplot.rda: bug in specification of `type` argument if not supplied
 	by the user; should have been a vector of length == 2.
+
+	* adipart, hiersimu, multipart: default and formula methods of
+	these functions were identical (also for the calculations) except
+	in interpreting the input. Now the formula method only interprets
+	the formula and calls the default method for the actual
+	calculations without replicating its code. The "call" attribute of
+	these functions now returns the generic function name without
+	".default", ".formula" suffix.
 	
 Version 2.1-16 (closed June 18, 2012)
 



More information about the Vegan-commits mailing list