From noreply at r-forge.r-project.org Mon Jul 8 05:18:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 05:18:16 +0200 (CEST) Subject: [Vegan-commits] r2541 - pkg/vegan/R Message-ID: <20130708031816.C41C7183F49@r-forge.r-project.org> Author: gsimpson Date: 2013-07-08 05:18:16 +0200 (Mon, 08 Jul 2013) New Revision: 2541 Added: pkg/vegan/R/plot.ordipointlabel.R Log: belated add of plot method for ordipointlabel Added: pkg/vegan/R/plot.ordipointlabel.R =================================================================== --- pkg/vegan/R/plot.ordipointlabel.R (rev 0) +++ pkg/vegan/R/plot.ordipointlabel.R 2013-07-08 03:18:16 UTC (rev 2541) @@ -0,0 +1,11 @@ +plot.ordipointlabel <- function (x, ...) +{ + plot(x$points, pch = x$args$pch, cex = x$args$pcex, col = x$args$pcol, + bg = x$args$pbg, asp = 1, ...) + font <- attr(x$labels, "font") + if (is.null(font)) + font <- par("font") + text(x$labels, rownames(x$labels), cex = x$args$tcex, col = x$args$tcol, + font = font, ...) + invisible(x) +} From noreply at r-forge.r-project.org Mon Jul 8 05:18:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 05:18:51 +0200 (CEST) Subject: [Vegan-commits] r2542 - pkg/vegan/man Message-ID: <20130708031851.949D2183F49@r-forge.r-project.org> Author: gsimpson Date: 2013-07-08 05:18:51 +0200 (Mon, 08 Jul 2013) New Revision: 2542 Modified: pkg/vegan/man/procrustes.Rd Log: fix typo Modified: pkg/vegan/man/procrustes.Rd =================================================================== --- pkg/vegan/man/procrustes.Rd 2013-07-08 03:18:16 UTC (rev 2541) +++ pkg/vegan/man/procrustes.Rd 2013-07-08 03:18:51 UTC (rev 2542) @@ -68,7 +68,7 @@ \item{control}{a list defining the permutation design, from a call to \code{\link{how}}.} \item{permutations}{A permutation matrix where each row gives the - permuted indices. If this is supplied, \code{cotrol} is ignored.} + permuted indices. If this is supplied, \code{control} is ignored.} \item{ar.col}{Arrow colour.} \item{len}{Width of the arrow head.} \item{labels}{Character vector of text labels. Rownames of the result From noreply at r-forge.r-project.org Mon Jul 8 05:19:38 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 05:19:38 +0200 (CEST) Subject: [Vegan-commits] r2543 - in pkg/vegan: R inst man Message-ID: <20130708031939.084FC183F49@r-forge.r-project.org> Author: gsimpson Date: 2013-07-08 05:19:38 +0200 (Mon, 08 Jul 2013) New Revision: 2543 Modified: pkg/vegan/R/permutest.betadisper.R pkg/vegan/inst/ChangeLog pkg/vegan/man/permutest.betadisper.Rd Log: adds a permutations argument Modified: pkg/vegan/R/permutest.betadisper.R =================================================================== --- pkg/vegan/R/permutest.betadisper.R 2013-07-08 03:18:51 UTC (rev 2542) +++ pkg/vegan/R/permutest.betadisper.R 2013-07-08 03:19:38 UTC (rev 2543) @@ -1,5 +1,6 @@ `permutest.betadisper` <- function(x, pairwise = FALSE, - control = how(nperm = 999), ...) + control = how(nperm = 999), + permutations = NULL, ...) { t.statistic <- function(x, y) { m <- length(x) @@ -11,7 +12,7 @@ pooled <- sqrt(((m-1)*xvar + (n-1)*yvar) / (m+n-2)) (xbar - ybar) / (pooled * sqrt(1/m + 1/n)) } - + if(!inherits(x, "betadisper")) stop("Only for class \"betadisper\"") ## will issue error if only a single group @@ -22,20 +23,29 @@ p <- mod.Q$rank resids <- qr.resid(mod.Q, x$distances) + N <- nrow(x) ## number of observations + ## extract groups group <- x$group - - ## get set of permutations - shuffleSet checks design - perms <- shuffleSet(length(group), control = control) + ## If permutations is NULL, work with control + if(is.null(permutations)) { + permutations <- shuffleSet(length(group), control = control) + } else { + permutations <- as.matrix(permutations) + if (ncol(permutations) != N) + stop(gettextf("'permutations' have %d columns, but data have %d observations", + ncol(permutations), N)) + } + ## number of permutations being performed, possibly adjusted after ## checking in shuffleSet - nperm <- nrow(perms) + nperm <- nrow(permutations) ## set-up objects to hold permuted results res <- numeric(length = nperm + 1) res[1] <- summary(mod)$fstatistic[1] - + ## pairwise comparisons if(pairwise) { ## unique pairings @@ -49,7 +59,7 @@ ## begin loop over shuffleSet perms for(i in seq_len(nperm)) { - perm <- perms[i,] ## take current permutation from set + perm <- permutations[i,] ## take current permutation from set perm.resid <- resids[perm] ## permute residuals f <- qr.fitted(mod.Q, perm.resid) ## create new data mss <- sum((f - mean(f))^2) @@ -58,7 +68,7 @@ rdf <- nobs - p resvar <- rss / rdf res[i+1] <- (mss / (p - 1)) / resvar - + ## pairwise comparisons if(pairwise) { for(j in seq_len(n.pairs)) { @@ -71,7 +81,7 @@ ## compute permutation p-value pval <- sum(res >= res[1]) / length(res) - + if(pairwise) { df <- apply(combin, 2, function(z) { length(x$distances[group == z[1]]) + @@ -84,7 +94,7 @@ } else { pairwise <- NULL } - + retval <- cbind(mod.aov[, 1:4], c(nperm, NA), c(pval, NA)) dimnames(retval) <- list(c("Groups", "Residuals"), c("Df", "Sum Sq", "Mean Sq", "F", "N.Perm", Modified: pkg/vegan/inst/ChangeLog =================================================================== --- pkg/vegan/inst/ChangeLog 2013-07-08 03:18:51 UTC (rev 2542) +++ pkg/vegan/inst/ChangeLog 2013-07-08 03:19:38 UTC (rev 2543) @@ -8,7 +8,9 @@ later. * betadisper, permutest.betadisper: Modified to use the new - permute package API (from version 0.7-3 onwards). + permute package API (from version 0.7-3 onwards). The `permutest` + method gains a new argument `permutations`, which takes a matrix + of permutations to be used. * protest: modified to use the new permute API. Gains argument `control` which describes the design. As a result, `strata` @@ -47,7 +49,7 @@ * stressplot: metaMDS and monoMDS stressplot() use now expression(R^2) instead of ascii R2. The stressplot.monoMDS() function returns the plotting structures in the original input - order. + order. * vignettes: Brian Ripley urged as to remove \usepackage{inconsolota} as this package is on the way to be Modified: pkg/vegan/man/permutest.betadisper.Rd =================================================================== --- pkg/vegan/man/permutest.betadisper.Rd 2013-07-08 03:18:51 UTC (rev 2542) +++ pkg/vegan/man/permutest.betadisper.Rd 2013-07-08 03:19:38 UTC (rev 2543) @@ -10,7 +10,8 @@ } \usage{ \method{permutest}{betadisper}(x, pairwise = FALSE, - control = how(nperm = 999), \dots) + control = how(nperm = 999), permutations = NULL, + \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ @@ -18,7 +19,9 @@ call to \code{betadisper}.} \item{pairwise}{logical; perform pairwise comparisons of group means?} \item{control}{a list of control values for the permutations - as returned by the function \code{\link[permute]{how}}} + as returned by the function \code{\link[permute]{how}}.} + \item{permutations}{A permutation matrix where each row gives the + permuted indices. If this is supplied, \code{control} is ignored.} \item{\dots}{Arguments passed to other methods.} } \details{ From noreply at r-forge.r-project.org Tue Jul 9 15:07:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 15:07:03 +0200 (CEST) Subject: [Vegan-commits] r2544 - in branches/2.0: . R inst inst/doc man Message-ID: <20130709130703.F09BE184FA8@r-forge.r-project.org> Author: jarioksa Date: 2013-07-09 15:07:03 +0200 (Tue, 09 Jul 2013) New Revision: 2544 Added: branches/2.0/R/ordiArrowTextXY.R Modified: branches/2.0/DESCRIPTION branches/2.0/R/betadisper.R branches/2.0/R/eigenvals.R branches/2.0/R/ordipointlabel.R branches/2.0/R/plot.cca.R branches/2.0/R/plot.envfit.R branches/2.0/R/print.betadisper.R branches/2.0/R/stressplot.R branches/2.0/R/text.cca.R branches/2.0/inst/ChangeLog branches/2.0/inst/doc/decision-vegan.Rnw branches/2.0/inst/doc/diversity-vegan.Rnw branches/2.0/inst/doc/intro-vegan.Rnw branches/2.0/inst/doc/veganjss.sty branches/2.0/man/adipart.Rd branches/2.0/man/betadisper.Rd branches/2.0/man/ordipointlabel.Rd branches/2.0/man/vegan-internal.Rd Log: Merge easy and clear fixes to vegan 2.0-8 * merge r2540: remove hard-coded inconsolata fonts. * merge r2539: stressplot return data in input order. * merge r2538: use expression(R^2) in stressplot. * merge r2535, 2536: better positioning of arrow labels. * merge r2533: ordipointlabel uses ordiArgAbsorber. * merge r2504: notation in adipart.Rd. * merge r2497: avoid visible ~ in .Rnw. * merge r2484 thru 2486: betadisper fixes Modified: branches/2.0/DESCRIPTION =================================================================== --- branches/2.0/DESCRIPTION 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/DESCRIPTION 2013-07-09 13:07:03 UTC (rev 2544) @@ -1,7 +1,7 @@ Package: vegan Title: Community Ecology Package Version: 2.0-8 -Date: March 19, 2013 +Date: July 9, 2013 Author: Jari Oksanen, F. Guillaume Blanchet, Roeland Kindt, Pierre Legendre, Peter R. Minchin, R. B. O'Hara, Gavin L. Simpson, Peter Solymos, M. Henry H. Stevens, Helene Wagner Modified: branches/2.0/R/betadisper.R =================================================================== --- branches/2.0/R/betadisper.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/betadisper.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -18,6 +18,18 @@ spMedNeg <- ordimedian(vectors, group, choices = axes[!pos]) cbind(spMedPos, spMedNeg) } + ## inline function for centroids + centroidFUN <- function(vec, group) { + cent <- apply(vec, 2, + function(x, group) tapply(x, INDEX = group, FUN = mean), + group = group) + if(!is.matrix(cent)) { ## if only 1 group, cent is vector + cent <- matrix(cent, nrow = 1, + dimnames = list(as.character(levels(group)), + paste0("Dim", seq_len(NCOL(vec))))) + } + cent + } ## inline function for distance computation Resids <- function(x, c) { if(is.matrix(c)) @@ -69,7 +81,6 @@ warning("Missing observations due to 'd' removed.") } x <- x + t(x) - storage.mode(x) <- "double" x <- dblcen(x) e <- eigen(-x/2, symmetric = TRUE) vectors <- e$vectors @@ -84,7 +95,7 @@ ## group centroids in PCoA space centroids <- switch(type, - centroid = apply(vectors, 2, function(x) tapply(x, group, mean)), + centroid = centroidFUN(vectors, group), median = spatialMed(vectors, group, pos) ) ## for each of the groups, calculate distance to centroid for Modified: branches/2.0/R/eigenvals.R =================================================================== --- branches/2.0/R/eigenvals.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/eigenvals.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -28,7 +28,7 @@ out } -## squares of sdev +## squares of sdev `eigenvals.prcomp` <- function(x, ...) { @@ -78,6 +78,13 @@ out } +## betadisper (vegan) +`eigenvals.betadisper` <- function(x, ...) { + out <- x$eig + class(out) <- "eigenvals" + out +} + ## dudi objects of ade4 `eigenvals.dudi` <- @@ -112,8 +119,8 @@ class(out) <- "eigenvals" out } - + `print.eigenvals` <- function(x, ...) { Copied: branches/2.0/R/ordiArrowTextXY.R (from rev 2535, pkg/vegan/R/ordiArrowTextXY.R) =================================================================== --- branches/2.0/R/ordiArrowTextXY.R (rev 0) +++ branches/2.0/R/ordiArrowTextXY.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -0,0 +1,27 @@ +### Location of the text at the point of the arrow. 'vect' are the +### coordinates of the arrow heads, and 'labels' are the text used to +### label these heads, '...' passes arguments (such as 'cex') to +### strwidth() and strheight(). +`ordiArrowTextXY` <- + function (vect, labels, ...) +{ + w <- strwidth(labels, ...) + h <- strheight(labels, ...) + ## slope of arrows + b <- vect[,2]/vect[,1] + ## offset based on string dimensions + off <- cbind(sign(vect[,1]) * (w/2 + h/4), 0.75 * h * sign(vect[,2])) + ## move the centre of the string to the continuation of the arrow + for(i in 1:nrow(vect)) { + move <- off[i,2] / b[i] + ## arrow points to the top/bottom of the text box + if (is.finite(move) && abs(move) <= abs(off[i, 1])) + off[i, 1] <- move + else { + ## arrow points to a side of the text box + move <- b[i] * off[i,1] + off[i, 2] <- move + } + } + off + vect +} Modified: branches/2.0/R/ordipointlabel.R =================================================================== --- branches/2.0/R/ordipointlabel.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/ordipointlabel.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -88,9 +88,13 @@ sol <- optim(par = pos, fn = fn, gr = gr, method="SANN", control=list(maxit=nit)) if (!add) - points(xy, pch = pch, col = col, cex=cex, ...) + ##points(xy, pch = pch, col = col, cex=cex, ...) + ordiArgAbsorber(xy, pch = pch, col = col, cex = cex, FUN = points, + ...) lab <- xy + makeoff(sol$par, box) - text(lab, labels=labels, col = col, cex = cex, font = font, ...) + ##text(lab, labels=labels, col = col, cex = cex, font = font, ...) + ordiArgAbsorber(lab, labels=labels, col = col, cex = cex, font = font, + FUN = text, ...) pl <- list(points = xy) pl$labels <- lab attr(pl$labels, "font") <- font Modified: branches/2.0/R/plot.cca.R =================================================================== --- branches/2.0/R/plot.cca.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/plot.cca.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -93,7 +93,8 @@ attr(g$biplot, "arrow.mul") <- mul arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2], length = 0.05, col = "blue") - text(1.1 * mul * g$biplot, rownames(g$biplot), col = "blue") + biplabs <- ordiArrowTextXY(mul * g$biplot, rownames(g$biplot)) + text(biplabs, rownames(g$biplot), col = "blue") axis(3, at = c(-mul, 0, mul), labels = rep("", 3), col = "blue") axis(4, at = c(-mul, 0, mul), labels = c(-1, 0, 1), col = "blue") } Modified: branches/2.0/R/plot.envfit.R =================================================================== --- branches/2.0/R/plot.envfit.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/plot.envfit.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -59,51 +59,67 @@ ax <- -c(-1, 0, 1) * arrow.mul * maxarr } vect <- arrow.mul * vect - vtext <- sweep(1.1 * vect, 2, at, "+") vect <- sweep(vect, 2, at, "+") + if (add) { + vtext <- ordiArrowTextXY(vect, labs$v, ...) + vtext <- sweep(vtext, 2, at, "+") + } } if (!add) { - plot.new() ## needed for string widths and heights - if(!is.null(vect)) { - ## compute axis limits allowing space for labels - sw <- strwidth(labs$v, ...) + plot.new() + ## needed for string widths and heights We need dimensions to + ## fit completely the names of vectors and factors with no + ## clipping at axes. If there are (1) factors and vectors, we + ## need to adjust arrow lengths, if there are (2) only factors + ## or only vectors, we can use their scores directly. After + ## finding the scores, we must expand the scores by string + ## widths and heights. The expansion can be only estimated + ## after setting plot.window with its xlim and ylim, but we + ## need to find xlim and ylim to set the plot.window... + + if(is.null(vect) || is.null(x$factors)) { + ## Only factors or vectors: set preliminary plot.window + xstack <- rbind(vect, x$factors$centroids) + plot.window(xlim = range(xstack[,1], at[1]), + ylim = range(xstack[,2], at[2]), + asp = 1, ...) + } else { + ## Both vectors and factors: set preliminary plot.window + ## from factors only and and find arrow.mul (which is + ## otherwise ## arrow.mul = 1) + plot.window(xlim = range(x$factors$centroids[,1], at[1]), + ylim = range(x$factors$centroids[,2], at[2]), + asp = 1, ...) + vfill <- 0.75 + arrow.mul <- ordiArrowMul(vect, at = at, fill = 1) + vect <- arrow.mul * vect + } + ## Get string dimensions (width/2, height) + sw <- strwidth(c(labs$v, labs$f), ...) / 2 + sh <- strheight(c(labs$v, labs$f), ...) + ## Reset limits + xstack <- rbind(x$factors$centroids, vect) + xlim <- range(xstack[,1] + sw, xstack[,2] - sw) + ylim <- range(xstack[,2] + sh, xstack[,2] - sh) + plot.window(xlim = xlim, ylim = ylim, asp = 1, ...) + ## Re-evaluate arrow.mul, set its text and re-evaluate limits again + if (!is.null(vect)) { + arrow.mul <- ordiArrowMul(vect, at = at, fill = 1) + vect <- arrow.mul * vect + vtext <- ordiArrowTextXY(vect, labs$v, ...) + sw <- strwidth(labs$v, ...) / 2 sh <- strheight(labs$v, ...) - xlim <- range(at[1], vtext[,1] + sw, vtext[,1] - sw) - ylim <- range(at[2], vtext[,2] + sh, vtext[,2] - sh) - if(!is.null(x$factors)) { - ## if factors, also need to consider them - sw <- strwidth(labs$f, ...) - sh <- strheight(labs$f, ...) - xlim <- range(xlim, x$factors$centroids[, choices[1]] + sw, - x$factors$centroids[, choices[1]] - sw) - ylim <- range(ylim, x$factors$centroids[, choices[2]] + sh, - x$factors$centroids[, choices[2]] - sh) - } - ## these plotting calls will prob. generate warnings - ## because of passing ... everywhere. localFoo needed? + xlim <- range(xlim, vtext[,1] + sw, vtext[,1] - sw) + ylim <- range(xlim, vtext[,2] + sh, vtext[,2] - sh) plot.window(xlim = xlim, ylim = ylim, asp = 1, ...) - axis(side = 1, ...) - axis(side = 2, ...) - box(...) - alabs <- colnames(vect) - title(..., ylab = alabs[2], xlab = alabs[1]) - } else if (!is.null(x$factors)) { - sw <- strwidth(labs$f, ...) - sh <- strheight(labs$f, ...) - xlim <- range(at[1], x$factors$centroids[, choices[1]] + sw, - x$factors$centroids[, choices[1]] - sw) - ylim <- range(at[2], x$factors$centroids[, choices[2]] + sh, - x$factors$centroids[, choices[2]] - sh) - ## these plotting calls will prob. generate warnings - ## because of passing ... everywhere. localFoo needed? - plot.window(xlim = xlim, ylim = ylim, asp = 1, ...) - axis(side = 1, ...) - axis(side = 2, ...) - box(...) - alabs <- colnames(x$factors$centroids[, choices, drop = FALSE]) - title(..., ylab = alabs[2], xlab = alabs[1]) - } else stop("Nothing to plot") + } + axis(side = 1, ...) + axis(side = 2, ...) + box(...) + alabs <- colnames(vect) + title(..., ylab = alabs[2], xlab = alabs[1]) } + if (!is.null(vect)) { arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05, col = col) Modified: branches/2.0/R/print.betadisper.R =================================================================== --- branches/2.0/R/print.betadisper.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/print.betadisper.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -1,6 +1,9 @@ `print.betadisper` <- function(x, digits = max(3, getOption("digits") - 3), - ...) + ...) { + ## limit number of eignvals to 8 + ax.lim <- 8 + ## cat("\n") writeLines(strwrap("Homogeneity of multivariate dispersions\n", prefix = "\t")) @@ -9,10 +12,12 @@ cat(paste("\nNo. of Positive Eigenvalues:", sum(x$eig > 0))) cat(paste("\nNo. of Negative Eigenvalues:", sum(x$eig < 0))) cat("\n\n") - writeLines(strwrap("Average distance to centroid:\n")) + type <- ifelse(isTRUE(all.equal(attr(x, "type"), "median")), + "medoid", "centroid") + writeLines(strwrap(paste0("Average distance to ", type, ":\n"))) print.default(tapply(x$distances, x$group, mean), digits = digits) cat("\n") writeLines(strwrap("Eigenvalues for PCoA axes:\n")) - print.default(round(x$eig, digits = digits)) + print.default(round(x$eig[seq_len(ax.lim)], digits = digits)) invisible(x) } Modified: branches/2.0/R/stressplot.R =================================================================== --- branches/2.0/R/stressplot.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/stressplot.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -61,10 +61,15 @@ ## Stress as R2 rstress <- 1 - object$stress^2 ralscal <- if(object$iregn == 3) ralscal/2 else ralscal/object$ngrp - lab <- paste("Non-metric fit, R2 =", format(rstress, digits=3), - "\nLinear fit, R2 =", format(ralscal, digits=3)) - text(min(x), 0.95*max(y), lab, pos=4) - invisible(list("x" = x, "y" = y, "yf" = yf)) + Rst <- format(rstress, digits = 3) + Ral <- format(ralscal, digits = 3) + lab1 <- bquote("Non-metric fit, " * R^2 == .(Rst)) + lab2 <- bquote("Linear fit, " * R^2 == .(Ral)) + text(min(x), 0.95*max(y), lab1, pos=4) + text(min(x), 0.95*max(y) - strheight(lab1), lab2, pos=4) + ## we want to have invisible return lists in the input order + o <- order(object$jidx, object$iidx) + invisible(list("x" = x[o], "y" = y[o], "yf" = yf[o])) } `stressplot.default` <- @@ -87,8 +92,11 @@ plot(shep, pch = pch, col = p.col, xlab = "Observed Dissimilarity", ylab = "Ordination Distance", ...) lines(shep$x, shep$yf, type = "S", col = l.col, lwd = lwd, ...) - lab <- paste("Non-metric fit, R2 =", format(rstress, digits=3), - "\nLinear fit, R2 =", format(ralscal, digits=3)) - text(min(shep$x), 0.95*max(shep$y), lab, pos=4) + Rst <- format(rstress, digits = 3) + Ral <- format(ralscal, digits = 3) + lab1 <- bquote("Non-metric fit, " * R^2 == .(Rst)) + lab2 <- bquote("Linear fit, " * R^2 == .(Ral)) + text(min(shep$x), 0.95*max(shep$y), lab1, pos=4) + text(min(shep$x), 0.95*max(shep$y) - strheight(lab1), lab2, pos=4) invisible(shep) } Modified: branches/2.0/R/text.cca.R =================================================================== --- branches/2.0/R/text.cca.R 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/R/text.cca.R 2013-07-09 13:07:03 UTC (rev 2544) @@ -29,7 +29,7 @@ pts <- pts * arrow.mul arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow, ...) - pts <- pts * 1.1 + pts <- ordiArrowTextXY(pts, rownames(pts), ...) if (axis.bp) { axis(side = 3, at = c(-arrow.mul, 0, arrow.mul), labels = rep("", 3)) Modified: branches/2.0/inst/ChangeLog =================================================================== --- branches/2.0/inst/ChangeLog 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/inst/ChangeLog 2013-07-09 13:07:03 UTC (rev 2544) @@ -4,9 +4,15 @@ Version 2.0-8 (opened March 19, 2013) - * version 2.0-7 may be the last release in 2.0 series, and the - next release version may be a major upgrade 2.2-0 (this - information may change if there is a need for a 2.0 release). + * merge r2540: remove hard-coded inconsolata fonts. + * merge r2539: stressplot return data in input order. + * merge r2538: use expression(R^2) in stressplot. + * merge r2535, 2536: better positioning of arrow labels. + * merge r2533: ordipointlabel uses ordiArgAbsorber. + * merge r2504: notation in adipart.Rd. + * merge r2497: avoid visible ~ in .Rnw. + * merge r2484 thru 2486: betadisper fixes (centroid with one + group, call it medoid). Version 2.0-7 (released March 19, 2013) Modified: branches/2.0/inst/doc/decision-vegan.Rnw =================================================================== --- branches/2.0/inst/doc/decision-vegan.Rnw 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/inst/doc/decision-vegan.Rnw 2013-07-09 13:07:03 UTC (rev 2544) @@ -8,6 +8,7 @@ %\usepackage[utf8x]{inputenc} %\usepackage[T1]{fontenc} \usepackage{sidecap} +\usepackage[english]{babel} % kluge to avoid visible ~ in Figure~1. \renewcommand{\floatpagefraction}{0.8} \renewcommand{\cite}{\citep} Modified: branches/2.0/inst/doc/diversity-vegan.Rnw =================================================================== --- branches/2.0/inst/doc/diversity-vegan.Rnw 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/inst/doc/diversity-vegan.Rnw 2013-07-09 13:07:03 UTC (rev 2544) @@ -8,8 +8,8 @@ \usepackage{sidecap} \usepackage{amsmath} \usepackage{amssymb} % \gtrapprox +\usepackage[english]{babel} % kluge to avoid visible ~ in Figure~1 - \title{Vegan: ecological diversity} \author{Jari Oksanen} \Abstract{ This document explains diversity related methods in Modified: branches/2.0/inst/doc/intro-vegan.Rnw =================================================================== --- branches/2.0/inst/doc/intro-vegan.Rnw 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/inst/doc/intro-vegan.Rnw 2013-07-09 13:07:03 UTC (rev 2544) @@ -7,6 +7,7 @@ \usepackage[T1]{fontenc} \usepackage{sidecap} \usepackage{amsmath} +\usepackage[english]{babel} % kluge to avoid visible ~ in Figure~1 \renewcommand{\floatpagefraction}{0.8} Modified: branches/2.0/inst/doc/veganjss.sty =================================================================== --- branches/2.0/inst/doc/veganjss.sty 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/inst/doc/veganjss.sty 2013-07-09 13:07:03 UTC (rev 2544) @@ -17,8 +17,9 @@ \textbf{\large \thesubsection. #2} \nopagebreak \vskip \postSskip \nopagebreak} -%% use inconsolata fonts for code and examples -\usepackage{inconsolata} +%% do not use inconsolata fonts for code and examples: they are to be +%% removed from CTAN +%\usepackage{inconsolata} %% smaller examples \renewenvironment{Schunk}{\par\small}{} Modified: branches/2.0/man/adipart.Rd =================================================================== --- branches/2.0/man/adipart.Rd 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/man/adipart.Rd 2013-07-09 13:07:03 UTC (rev 2544) @@ -93,7 +93,7 @@ At the highest sampling level, the diversity components are calculated as \deqn{\beta_m = \gamma - \alpha_m}{beta_m = gamma - alpha_m} For each lower sampling level as \deqn{\beta_i = \alpha_{i+1} - - \alpha_i}{beta_i = alpha_i+1 - alpha_i} Then, the additive partition + \alpha_i}{beta_i = alpha_(i+1) - alpha_i} Then, the additive partition of diversity is \deqn{\gamma = \alpha_1 + \sum_{i=1}^m \beta_i}{gamma = alpha_1 + sum(beta_i)} Modified: branches/2.0/man/betadisper.Rd =================================================================== --- branches/2.0/man/betadisper.Rd 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/man/betadisper.Rd 2013-07-09 13:07:03 UTC (rev 2544) @@ -6,6 +6,7 @@ \alias{plot.betadisper} \alias{boxplot.betadisper} \alias{TukeyHSD.betadisper} +\alias{eigenvals.betadisper} \alias{ordimedian} \title{Multivariate homogeneity of groups dispersions (variances)} @@ -33,6 +34,8 @@ \method{scores}{betadisper}(x, display = c("sites", "centroids"), choices = c(1,2), \dots) +\method{eigenvals}{betadisper}(x, \dots) + \method{plot}{betadisper}(x, axes = c(1,2), cex = 0.7, hull = TRUE, ylab, xlab, main, sub, \dots) @@ -160,6 +163,8 @@ The \code{boxplot} function invisibly returns a list whose components are documented in \code{\link[graphics]{boxplot}}. + \code{eigenvals.betadisper} returns a named vector of eigenvalues. + \code{TukeyHSD.betadisper} returns a list. See \code{\link{TukeyHSD}} for further details. @@ -251,6 +256,23 @@ ## Draw a boxplot of the distances to centroid for each group boxplot(mod) +## `scores` and `eigenvals` also work +scrs <- scores(mod) +str(scrs) +head(scores(mod, 1:4, display = "sites")) +# group centroids/medoids +scores(mod, 1:4, display = "centroids") +# eigenvalues from the underlying principal coordinates analysis +eigenvals(mod) + +## try out bias correction; compare with mod3 +(mod3B <- betadisper(dis, groups, type = "median", bias.adjust=TRUE)) + +## should always work for a single group +group <- factor(rep("grazed", NROW(varespec))) +(tmp <- betadisper(dis, group, type = "median")) +(tmp <- betadisper(dis, group, type = "centroid")) + ## simulate missing values in 'd' and 'group' ## using spatial medians groups[c(2,20)] <- NA @@ -272,9 +294,6 @@ boxplot(mod3) plot(TukeyHSD(mod3)) -## try out bias correction; compare with mod3 -(mod3B <- betadisper(dis, groups, type = "median", bias.adjust=TRUE)) - } \keyword{methods} \keyword{multivariate} Modified: branches/2.0/man/ordipointlabel.Rd =================================================================== --- branches/2.0/man/ordipointlabel.Rd 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/man/ordipointlabel.Rd 2013-07-09 13:07:03 UTC (rev 2544) @@ -75,6 +75,14 @@ data(dune) ord <- cca(dune) ordipointlabel(ord) + +## set scaling - should be no warnings! +ordipointlabel(ord, scaling = 1) + +## plot then add +plot(ord, scaling = 3, type = "n") +ordipointlabel(ord, display = "species", scaling = 3, add = TRUE) +ordipointlabel(ord, display = "sites", scaling = 3, add = TRUE) } \keyword{ hplot } \keyword{ aplot } Modified: branches/2.0/man/vegan-internal.Rd =================================================================== --- branches/2.0/man/vegan-internal.Rd 2013-07-08 03:19:38 UTC (rev 2543) +++ branches/2.0/man/vegan-internal.Rd 2013-07-09 13:07:03 UTC (rev 2544) @@ -8,6 +8,7 @@ \alias{ordiTerminfo} \alias{pasteCall} \alias{ordiArrowMul} +\alias{oridArrowTextXY} \alias{ordiArgAbsorber} \alias{veganCovEllipse} \alias{hierParseFormula} @@ -26,6 +27,7 @@ ordiNAexclude(x, excluded) ordiNApredict(omit, x) ordiArrowMul(x, at = c(0,0), fill = 0.75) +ordiArrowTextXY(vect, labels, ...) ordiArgAbsorber(..., shrink, origin, scaling, triangular, display, choices, const, FUN) centroids.cca(x, mf, wt) @@ -62,6 +64,11 @@ \code{ordiNApredict} puts pads the result object with these or with WA scores similarly as \code{\link{napredict}}. + \code{ordiArrowMul} finds a multiplier to scale a bunch of arrows to + fill an ordination plot, and \code{ordiArrowTextXY} finds the + coordinates for labels of these arrows. See \code{\link{envfit}} + for an application. + \code{ordiArgAbsorber} absorbs arguments of \code{\link{scores}} function of \pkg{vegan} so that these do not cause superfluous warnings in graphical function \code{FUN}. If you implement From noreply at r-forge.r-project.org Tue Jul 9 15:22:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 15:22:12 +0200 (CEST) Subject: [Vegan-commits] r2545 - in branches/2.0: R inst man Message-ID: <20130709132212.A627C1848DA@r-forge.r-project.org> Author: jarioksa Date: 2013-07-09 15:22:12 +0200 (Tue, 09 Jul 2013) New Revision: 2545 Modified: branches/2.0/R/ordisurf.R branches/2.0/R/plot.ordisurf.R branches/2.0/inst/ChangeLog branches/2.0/man/ordisurf.Rd Log: merge ordisurf upgrades r2490:2493, 2534 Modified: branches/2.0/R/ordisurf.R =================================================================== --- branches/2.0/R/ordisurf.R 2013-07-09 13:07:03 UTC (rev 2544) +++ branches/2.0/R/ordisurf.R 2013-07-09 13:22:12 UTC (rev 2545) @@ -17,17 +17,23 @@ `ordisurf.default` <- function (x, y, choices = c(1, 2), knots = 10, family = "gaussian", - col = "red", thinplate = TRUE, add = FALSE, display = "sites", - w = weights(x), main, nlevels = 10, levels, labcex = 0.6, - bubble = FALSE, cex = 1, select = FALSE, - method = "GCV.Cp", gamma = 1, plot = TRUE, ...) + col = "red", isotropic = TRUE, thinplate = TRUE, bs = "tp", + fx = FALSE, add = FALSE, display = "sites", w = weights(x), + main, nlevels = 10, levels, npoints = 31, labcex = 0.6, + bubble = FALSE, cex = 1, select = TRUE, method = "REML", + gamma = 1, plot = TRUE, lwd.cl = par("lwd"), ...) { weights.default <- function(object, ...) NULL - GRID = 31 + if(!missing(thinplate)) { + warning("Use of 'thinplate' is deprecated and will soon be removed;\nuse 'isotropic' instead.") + isotropic <- thinplate + } + ## GRID no user-definable - why 31? + GRID <- npoints w <- eval(w) if (!is.null(w) && length(w) == 1) w <- NULL - require(mgcv) || stop("Requires package 'mgcv'") + require(mgcv) || stop("Requires package 'mgcv'") X <- scores(x, choices = choices, display = display, ...) ## The original name of 'y' may be lost in handling NA: save for ## plots @@ -40,21 +46,76 @@ } x1 <- X[, 1] x2 <- X[, 2] - if (knots <= 0) - mod <- gam(y ~ x1 + x2, family = family, weights = w) - else if (knots == 1) - mod <- gam(y ~ poly(x1, 1) + poly(x2, 1), - family = family, weights = w, method = method) - else if (knots == 2) - mod <- gam(y ~ poly(x1, 2) + poly(x2, 2) + poly(x1, 1):poly(x2, 1), - family = family, weights = w, method = method) - else if (thinplate) - mod <- gam(y ~ s(x1, x2, k = knots), family = family, - weights = w, select = select, method = method, - gamma = gamma) - else mod <- gam(y ~ s(x1, k = knots) + s(x2, k = knots), family = family, - weights = w, select = select, method = method, - gamma = gamma) + ## handle fx - allow vector of length up to two + if(!(missfx <- missing(fx)) && missing(knots)) + warning("Requested fixed d.f. splines but without specifying 'knots'.\nSwitching to 'fx = FALSE'.") + if (length(fx) > 2L) + warning("Length of 'fx' supplied exceeds '2'. Using the first two.") + ## expand fx robustly, no matter what length supplied + fx <- rep(fx, length.out = 2) + ## can't have `fx = TRUE` and `select = TRUE` + if(!missfx) { ## fx set by user + if((miss.select <- missing(select)) && any(fx)) { + warning("'fx = TRUE' requested; using 'select = FALSE'") + select <- FALSE + } else if(!miss.select && isTRUE(select)){ + stop("Fixed d.f. splines ('fx = TRUE') incompatible with 'select = TRUE'") + } + } + ## handle knots - allow vector of length up to two + if (length(knots) > 2L) + warning("Length of 'knots' supplied exceeds '2'. Using the first two.") + ## expand knots robustly, no matter what length supplied + knots <- rep(knots, length.out = 2) + ## handle the bs - we only allow some of the possible options + if (length(bs) > 2L) + warning("Number of basis types supplied exceeds '2'. Only using the first two.") + bs <- rep(bs, length.out = 2) + ## check allowed types + BS <- c("tp","ts","cr","cs","ds","ps","ad") + want <- match(bs, BS) + user.bs <- bs ## store supplied (well expanded supplied ones) + bs <- BS[want] + if (any(wrong <- is.na(bs))) { + stop(paste("Supplied basis type of", + paste(sQuote(unique(user.bs[wrong])), collapse = ", "), + "not supported.")) + } + ## can't use "cr", "cs", "ps" in 2-d smoother with s() + if(isTRUE(isotropic) && any(bs %in% c("cr", "cs", "ps"))) { + stop("Bases \"cr\", \"cs\", and \"ps\" not allowed in isotropic smooths.") + } + ## Build formula + if (knots[1] <= 0) { + f <- formula(y ~ x1 + x2) + } else if (knots[1] == 1) { ## why do we treat this differently? + f <- formula(y ~ poly(x1, 1) + poly(x2, 1)) + } else if (knots[1] == 2) { + f <- formula(y ~ poly(x1, 2) + poly(x2, 2) + poly(x1, 1):poly(x2, 1)) + } else if (isotropic) { + f <- formula(paste0("y ~ s(x1, x2, k = ", knots[1], + ", bs = \"", bs[1], "\", fx = ", fx[1],")")) + } else { + if (any(bs %in% c("ad"))) { + ## only "ad" for now, but "fs" should also not be allowed + f <- formula(paste0("y ~ s(x1, k = ", knots[1], + ", bs = \"", bs[1], + "\", fx = ", fx[1], ") + s(x2, k = ", + knots[2], ", bs = \"", bs[2], + "\", fx = ", fx[2], ")")) + } else { + f <- formula(paste0("y ~ te(x1, x2, k = c(", + paste0(knots, collapse = ", "), + "), bs = c(", + paste0("\"", bs, "\"", collapse = ", "), + "), fx = c(", + paste0(fx, collapse = ", "), + "))")) + } + } + ## fit model + mod <- gam(f, family = family, weights = w, select = select, + method = method, gamma = gamma) xn1 <- seq(min(x1), max(x1), len=GRID) xn2 <- seq(min(x2), max(x2), len=GRID) newd <- expand.grid(x1 = xn1, x2 = xn2) @@ -62,14 +123,17 @@ poly <- chull(cbind(x1,x2)) ## Move out points of the convex hull to have contour for all data ## points - xhull1 <- x1[poly] + sign(x1[poly] - mean(x1[poly])) * diff(range(x1))/(GRID - 1) - xhull2 <- x2[poly] + sign(x2[poly] - mean(x2[poly])) * diff(range(x2))/(GRID - 1) + xhull1 <- x1[poly] + sign(x1[poly] - mean(x1[poly])) * + diff(range(x1))/(GRID - 1) + xhull2 <- x2[poly] + sign(x2[poly] - mean(x2[poly])) * + diff(range(x2))/(GRID - 1) npol <- length(poly) np <- nrow(newd) inpoly <- numeric(np) - inpoly <- .C("pnpoly", as.integer(npol), as.double(xhull1), as.double(xhull2), - as.integer(np), as.double(newd[,1]), as.double(newd[,2]), - inpoly = as.integer(inpoly), PACKAGE="vegan")$inpoly + inpoly <- .C("pnpoly", as.integer(npol), as.double(xhull1), + as.double(xhull2), as.integer(np), as.double(newd[,1]), + as.double(newd[,2]), inpoly = as.integer(inpoly), + PACKAGE="vegan")$inpoly is.na(fit) <- inpoly == 0 if(plot) { if (!add) { @@ -88,10 +152,12 @@ if (missing(levels)) levels <- pretty(range(fit, finite = TRUE), nlevels) ## Only plot surface is select is FALSE or (TRUE and EDF is diff from 0) - if(!select || (select && !isTRUE(all.equal(as.numeric(summary(mod)$edf), 0)))) + if(!select || + (select && !isTRUE(all.equal(as.numeric(summary(mod)$edf), 0)))) contour(xn1, xn2, matrix(fit, nrow=GRID), col = col, add = TRUE, levels = levels, labcex = labcex, - drawlabels = !is.null(labcex) && labcex > 0) + drawlabels = !is.null(labcex) && labcex > 0, + lwd = lwd.cl) } mod$grid <- list(x = xn1, y = xn2, z = matrix(fit, nrow = GRID)) class(mod) <- c("ordisurf", class(mod)) Modified: branches/2.0/R/plot.ordisurf.R =================================================================== --- branches/2.0/R/plot.ordisurf.R 2013-07-09 13:07:03 UTC (rev 2544) +++ branches/2.0/R/plot.ordisurf.R 2013-07-09 13:22:12 UTC (rev 2545) @@ -1,6 +1,7 @@ `plot.ordisurf` <- function(x, what = c("contour","persp","gam"), add = FALSE, bubble = FALSE, col = "red", cex = 1, - nlevels = 10, levels, labcex = 0.6, ...) { + nlevels = 10, levels, labcex = 0.6, + lwd.cl = par("lwd"), ...) { what <- match.arg(what) y <- x$model$y x1 <- x$model$x1 @@ -23,7 +24,8 @@ levels <- pretty(range(x$grid$z, finite = TRUE), nlevels) contour(X, Y, Z, col = col, add = TRUE, levels = levels, labcex = labcex, - drawlabels = !is.null(labcex) && labcex > 0) + drawlabels = !is.null(labcex) && labcex > 0, + lwd = lwd.cl) } else if(isTRUE(all.equal(what, "persp"))) { persp(X, Y, Z, col = col, cex = cex, ...) } else { Modified: branches/2.0/inst/ChangeLog =================================================================== --- branches/2.0/inst/ChangeLog 2013-07-09 13:07:03 UTC (rev 2544) +++ branches/2.0/inst/ChangeLog 2013-07-09 13:22:12 UTC (rev 2545) @@ -8,9 +8,11 @@ * merge r2539: stressplot return data in input order. * merge r2538: use expression(R^2) in stressplot. * merge r2535, 2536: better positioning of arrow labels. + * merge r2534: lwd in ordisurf. * merge r2533: ordipointlabel uses ordiArgAbsorber. * merge r2504: notation in adipart.Rd. * merge r2497: avoid visible ~ in .Rnw. + * merge r2490 thru 2493: ordisurf new options. * merge r2484 thru 2486: betadisper fixes (centroid with one group, call it medoid). Modified: branches/2.0/man/ordisurf.Rd =================================================================== --- branches/2.0/man/ordisurf.Rd 2013-07-09 13:07:03 UTC (rev 2544) +++ branches/2.0/man/ordisurf.Rd 2013-07-09 13:22:12 UTC (rev 2545) @@ -11,11 +11,13 @@ plots the result on ordination diagram. } \usage{ -\method{ordisurf}{default}(x, y, choices=c(1, 2), knots=10, family="gaussian", col="red", - thinplate = TRUE, add = FALSE, display = "sites", - w = weights(x), main, nlevels = 10, levels, labcex = 0.6, - bubble = FALSE, cex = 1, select = FALSE, method = "GCV.Cp", - gamma = 1, plot = TRUE, ...) +\method{ordisurf}{default}(x, y, choices = c(1, 2), knots = 10, + family = "gaussian", col = "red", isotropic = TRUE, + thinplate = TRUE, bs = "tp", fx = FALSE, add = FALSE, + display = "sites", w = weights(x), main, nlevels = 10, + levels, npoints = 31, labcex = 0.6, bubble = FALSE, + cex = 1, select = TRUE, method = "REML", gamma = 1, + plot = TRUE, lwd.cl = par("lwd"), ...) \method{ordisurf}{formula}(formula, data, ...) @@ -23,25 +25,46 @@ \method{plot}{ordisurf}(x, what = c("contour","persp","gam"), add = FALSE, bubble = FALSE, col = "red", cex = 1, - nlevels = 10, levels, labcex = 0.6, \dots) + nlevels = 10, levels, labcex = 0.6, lwd.cl = par("lwd"), \dots) } \arguments{ \item{x}{For \code{ordisurf} an ordination configuration, either a matrix or a result known by \code{\link{scores}}. For - \code{plot.ordisurf} and object of class \code{"ordisurf"} as + \code{plot.ordisurf} an object of class \code{"ordisurf"} as returned by \code{ordisurf}.} - \item{y}{ Variable to be plotted. } + \item{y}{Variable to be plotted / modelled as a function of the + ordination scores.} \item{choices}{Ordination axes. } \item{knots}{Number of initial knots in \code{\link[mgcv]{gam}} (one more than degrees of freedom). If \code{knots = 0} or \code{knots = 1} the function will fit a linear trend surface, and if \code{knots = 2} the function will fit a quadratic trend surface - instead of a smooth surface. } - \item{family}{ Error distribution in \code{\link[mgcv]{gam}}. } + instead of a smooth surface. A vector of length 2 is allowed when + \code{isotropic = FALSE}, with the first and second elements of + \code{knots} refering to the first and second of ordination + dimensions (as indicated by \code{choices}) respectively.} + \item{family}{Error distribution in \code{\link[mgcv]{gam}}.} \item{col}{ Colour of contours. } - \item{thinplate}{Use thinplate splines in \code{\link[mgcv]{gam}}.} - \item{add}{Add contours on an existing diagram or draw a new plot. } + \item{isotropic, thinplate}{Fit an isotropic smooth surface (i.e. same + smoothness in both ordination dimensions) via + \code{\link[mgcv]{gam}}. Use of \code{thinplate} is deprecated and + will be removed in a future version of the package.} + \item{bs}{a two letter character string indicating the smoothing basis + to use. (eg \code{"tp"} for thin plate regression spline, + \code{"cr"} for cubic regression spline). One of \code{c("tp", "ts", + "cr", "cs", "ds", "ps", "ad")}. See + \code{\link[mgcv]{smooth.terms}} for an over view of what these + refer to. The default is to use thin plate splines: \code{bs = "tp"}.} + \item{fx}{indicates whether the smoothers are fixed degree of freedom + regression splines (\code{fx = FALSE}) or penalised regression + splines (\code{fx = TRUE}). Can be a vector of length 2 for + anisotropic surfaces (\code{isotropic = FALSE}). It doesn't make + sense to use \code{fx = TRUE} \strong{and} \code{select = TRUE} and + it is an \strong{error} to do so. A warning is issued if you specify + \code{fx = TRUE} and forget to use \code{select = FALSE} though + fitting continues using \code{select = FALSE}.} + \item{add}{Add contours to an existing diagram or draw a new plot?} \item{display}{Type of scores known by \code{\link{scores}}: typically "sites" for ordinary site scores or "lc" for linear combination scores.} \item{w}{Prior weights on the data. Concerns mainly \code{\link{cca}} @@ -49,11 +72,14 @@ \item{main}{The main title for the plot, or as default the name of plotted variable in a new plot.} \item{nlevels, levels}{Either a vector of \code{levels} for which contours - are drawn, or suggested number of contours in - \code{nlevels} if \code{levels} are not supplied.} + are drawn, or suggested number of contours in \code{nlevels} if + \code{levels} are not supplied.} + \item{npoints}{numeric; the number of locations at which to evaluate + the fitted surface. This represents the number of locations in each + dimension.} \item{labcex}{Label size in contours. Setting this zero will suppress labels.} - \item{bubble}{Use \dQuote{bubble plot} for points, or vary the point + \item{bubble}{Use a \dQuote{bubble plot} for points, or vary the point diameter by the value of the plotted variable. If \code{bubble} is numeric, its value is used for the maximum symbol size (as in \code{cex}), or if \code{bubble = TRUE}, the value of \code{cex} gives @@ -78,12 +104,14 @@ of the scale.} \item{gamma}{Multiplier to inflate model degrees of freedom in GCV or UBRE/AIC score by. This effectively places an extra penalty on - complex models. An oft used value if \code{gamma = 1.4}.} + complex models. An oft-used value is \code{gamma = 1.4}.} \item{plot}{logical; should any plotting be done by \code{ordisurf}? Useful if all you want is the fitted response surface model.} + \item{lwd.cl}{numeric; the \code{lwd} (line width) parameter to use + when drawing the contour lines.} \item{formula, data}{Alternative definition of the fitted model as - \code{x ~ y}, or left-hand side is the ordination \code{x} and + \code{x ~ y}, where left-hand side is the ordination \code{x} and right-hand side the single fitted continuous variable \code{y}. The variable \code{y} must be in the working environment or in the data frame or environment given by \code{data}. All @@ -98,44 +126,52 @@ details. \code{"gam"} plots the fitted GAM model, an object that inherits from class \code{"gam"} returned by \code{ordisurf}, see \code{\link[mgcv]{plot.gam}}.} - \item{\dots}{Other parameters passed to \code{\link[mgcv]{gam}}, or + \item{\dots}{Other parameters passed to \code{\link{scores}}, or to the graphical functions. See Note below for exceptions.} } \details{ - Function \code{ordisurf} fits a smooth surface using thinplate + Function \code{ordisurf} fits a smooth surface using penalised splines (Wood 2003) in \code{\link[mgcv]{gam}}, and uses \code{\link[mgcv]{predict.gam}} to find fitted values in a regular grid. The smooth surface can be fitted with an extra penalty that allows the entire smoother to be penalized back to 0 degrees of freedom, effectively removing the term from the model (see Marra & Wood, 2011). The addition of this extra penalty is invoked by - setting argument \code{select} to \code{TRUE}. The function plots - the fitted contours with convex hull of data points either over an - existing ordination diagram or draws a new plot. If - \code{select = TRUE} and the smooth is effectively penalised out of + setting argument \code{select} to \code{TRUE}. An alternative is to + use a spline basis that includes shrinkage (\code{bs = "ts"} or + \code{bs = "cs"}). + + \code{ordisurf()} exposes a large number of options from + \code{\link[mgcv]{gam}} for specifying the basis functions used for + the surface. If you stray from the defaults, do read the + \strong{Notes} section below and relevant documentation in + \code{\link[mgcv]{s}} and \code{\link[mgcv]{smooth.terms}}. + + The function plots the fitted contours with convex hull of data points + either over an existing ordination diagram or draws a new plot. If + \code{select = TRUE} and the smooth is effectively penalised out of the model, no contours will be plotted. \code{\link[mgcv]{gam}} determines the degree of smoothness for the - fitted response surface during model fitting. Argument \code{method} - controls how \code{\link[mgcv]{gam}} performs this smoothness - selection. See \code{\link[mgcv]{gam}} for details of the available - options. Using \code{"REML"} or \code{"ML"} yields p-values for - smooths with the best coverage properties if such things matter to - you. + fitted response surface during model fitting, unless \code{fx = + TRUE}. Argument \code{method} controls how \code{\link[mgcv]{gam}} + performs this smoothness selection. See \code{\link[mgcv]{gam}} for + details of the available options. Using \code{"REML"} or \code{"ML"} + yields p-values for smooths with the best coverage properties if such + things matter to you. The function uses \code{\link{scores}} to extract ordination scores, and \code{x} can be any result object known by that function. - User can supply a vector of prior weights \code{w}. If the ordination - object has weights, these will be used. In practise this means that - the row totals are used as weights with - \code{\link{cca}} or - \code{\link{decorana}} results. If you do not like this, but want to give - equal weights to all sites, you should set \code{w = NULL}. The - behaviour is consistent with \code{\link{envfit}}. For complete - accordance with constrained \code{\link{cca}}, you should set + The user can supply a vector of prior weights \code{w}. If the + ordination object has weights, these will be used. In practise this + means that the row totals are used as weights with \code{\link{cca}} + or \code{\link{decorana}} results. If you do not like this, but want + to give equal weights to all sites, you should set \code{w = + NULL}. The behaviour is consistent with \code{\link{envfit}}. For + complete accordance with constrained \code{\link{cca}}, you should set \code{display = "lc"} (and possibly \code{scaling = 2}). Function \code{calibrate} returns the fitted values of the response @@ -146,25 +182,46 @@ } \value{ - Function is usually called for its side effect of drawing the - contour plot. The function returns the result object of class + \code{ordisurf} is usually called for its side effect of drawing the + contour plot. The function returns a result object of class \code{"ordisurf"} that inherits from \code{\link[mgcv]{gam}} used internally to fit the surface, but adds an item \code{grid} that contains the data for the grid surface. The item \code{grid} has elements \code{x} and \code{y} which are vectors of axis coordinates, and element \code{z} that is a matrix of fitted values for \code{\link{contour}}. The values outside the convex hull of observed - points are \code{NA} in \code{z}. The \code{\link[mgcv]{gam}} - component of the result can be used for further analysis like - predicting new values (see \code{\link[mgcv]{predict.gam}}). + points are indicated as \code{NA} in \code{z}. The + \code{\link[mgcv]{gam}} component of the result can be used for + further analysis like predicting new values (see + \code{\link[mgcv]{predict.gam}}). } \author{ Dave Roberts, Jari Oksanen and Gavin L. Simpson } \note{ - The default is to use thinplate splines. These make sense in - ordination as they have equal smoothing in all directions and are - rotation invariant. + The default is to use an isotropic smoother via + \code{\link[mgcv]{s}} employing thin plate regression splines + (\code{bs = "tp"}). These make sense in ordination as they have + equal smoothing in all directions and are rotation invariant. However, + if different degrees of smoothness along dimensions are required, an + anisotropic smooth surface may be more applicable. This can be + achieved through the use of \code{isotropic = FALSE}, wherein the + surface is fitted via a tensor product smoother via + \code{\link[mgcv]{te}} (unless \code{bs = "ad"}, in which case + separate splines for each dimension are fitted using + \code{\link[mgcv]{s}}). + Cubic regression splines and P splines can \strong{only} be used with + \code{isotropic = FALSE}. + + Adaptive smooths (\code{bs = "ad"}), especially in two dimensions, + require a large number of observations; without many hundreds of + observations, the default complexities for the smoother will exceed + the number of observations and fitting will fail. + + To get the old behaviour of \code{ordisurf} use \code{select = FALSE}, + \code{method = "GCV.Cp"}, \code{fx = FALSE}, and \code{bs = "tp"}. The + latter two options are the current defaults. + Graphical arguments supplied to \code{plot.ordisurf} are passed on to the underlying plotting functions, \code{contour}, \code{persp}, and \code{\link[mgcv]{plot.gam}}. The exception to this is that arguments @@ -177,6 +234,20 @@ illustration of this. } +\section{Warning}{ + The fitted GAM is a regression model and has the usual assumptions of + such models. Of particular note is the assumption of independence of + residuals. If the observations are not independent (e.g. they are + repeat measures on a set of objects, or from an experimental design, + \emph{inter alia}) do not trust the \emph{p}-values from the GAM + output. + + If you need further control (i.e. to add additional fixed effects to + the model, or use more complex smoothers), extract the ordination + scores using the \code{scores} function and then generate your own + \code{\link[mgcv]{gam}} call. +} + \references{ Marra, G.P & Wood, S.N. (2011) Practical variable selection for @@ -200,15 +271,28 @@ vare.mds <- monoMDS(vare.dist) with(varechem, ordisurf(vare.mds, Baresoil, bubble = 5)) -## as above but with extra penalties on smooth terms: -with(varechem, ordisurf(vare.mds, Baresoil, bubble = 5, col = "blue", - add = TRUE, select = TRUE)) +## as above but without the extra penalties on smooth terms, +## and using GCV smoothness selection (old behaviour of `ordisurf()`): +with(varechem, ordisurf(vare.mds, Baresoil,col = "blue", add = TRUE, + select = FALSE, method = "GCV.Cp")) ## Cover of Cladina arbuscula fit <- with(varespec, ordisurf(vare.mds, Cla.arb, family=quasipoisson)) ## Get fitted values calibrate(fit) +## Variable selection via additional shrinkage penalties +## This allows non-significant smooths to be selected out +## of the model not just to a linear surface. There are 2 +## options available: +## - option 1: `select = TRUE` --- the *default* +with(varechem, + ordisurf(vare.mds, Baresoil, method = "REML", select = TRUE)) +## - option 2: use a basis with shrinkage +with(varechem, + ordisurf(vare.mds, Baresoil, method = "REML", bs = "ts")) +## or bs = "cs" with `isotropic = FALSE` + ## Plot method plot(fit, what = "contour") @@ -217,6 +301,25 @@ ## or via plot.gam directly plot.gam(fit, cex = 2, pch = 1, col = "blue") ## 'col' effects all objects drawn... + +### controlling the basis functions used +## Use Duchon splines +with(varechem, ordisurf(vare.mds, Baresoil, bs = "ds")) + +## A fixed degrees of freedom smooth, must use 'select = FALSE' +with(varechem, ordisurf(vare.mds, Baresoil, knots = 4, + fx = TRUE, select = FALSE)) + +## An anisotropic smoother with cubic regression spline bases +with(varechem, ordisurf(vare.mds, Baresoil, isotropic = FALSE, + bs = "cr", knots = 4)) + +## An anisotropic smoother with cubic regression spline with +## shrinkage bases & different degrees of freedom in each dimension +with(varechem, ordisurf(vare.mds, Baresoil, isotropic = FALSE, + bs = "cs", knots = c(3,4), fx = TRUE, + select = FALSE)) + } \keyword{ multivariate } \keyword{ aplot } From noreply at r-forge.r-project.org Tue Jul 9 15:32:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 15:32:28 +0200 (CEST) Subject: [Vegan-commits] r2546 - in branches/2.0: R inst man Message-ID: <20130709133228.E1A511848DA@r-forge.r-project.org> Author: jarioksa Date: 2013-07-09 15:32:28 +0200 (Tue, 09 Jul 2013) New Revision: 2546 Modified: branches/2.0/R/oecosimu.R branches/2.0/R/print.oecosimu.R branches/2.0/R/raupcrick.R branches/2.0/inst/ChangeLog branches/2.0/man/oecosimu.Rd Log: merge r2495,8: test direction in oecosimu Modified: branches/2.0/R/oecosimu.R =================================================================== --- branches/2.0/R/oecosimu.R 2013-07-09 13:22:12 UTC (rev 2545) +++ branches/2.0/R/oecosimu.R 2013-07-09 13:32:28 UTC (rev 2546) @@ -102,8 +102,8 @@ z <- (indstat - means)/sd if (any(sd < sqrt(.Machine$double.eps))) z[sd < sqrt(.Machine$double.eps)] <- 0 - pless <- rowSums(indstat <= simind, na.rm = TRUE) - pmore <- rowSums(indstat >= simind, na.rm = TRUE) + pless <- rowSums(indstat >= simind, na.rm = TRUE) + pmore <- rowSums(indstat <= simind, na.rm = TRUE) if (any(is.na(simind))) { warning("some simulated values were NA and were removed") nsimul <- nsimul - rowSums(is.na(simind)) Modified: branches/2.0/R/print.oecosimu.R =================================================================== --- branches/2.0/R/print.oecosimu.R 2013-07-09 13:22:12 UTC (rev 2545) +++ branches/2.0/R/print.oecosimu.R 2013-07-09 13:32:28 UTC (rev 2546) @@ -13,10 +13,10 @@ cat("options: ", paste(names(att), att, collapse=", ")) } alt.char <- switch(x$oecosimu$alternative, - two.sided = "not equal to", + two.sided = "less or greater than", less = "less than", greater = "greater than") - cat("\nalternative hypothesis: simulated median is", alt.char, "the statistic") + cat("\nalternative hypothesis: statistic is", alt.char, "simulated values") ## dim attribute is always there, but print all others cat("\n\n") Modified: branches/2.0/R/raupcrick.R =================================================================== --- branches/2.0/R/raupcrick.R 2013-07-09 13:22:12 UTC (rev 2545) +++ branches/2.0/R/raupcrick.R 2013-07-09 13:32:28 UTC (rev 2546) @@ -12,7 +12,7 @@ ## but is much slower sol <- oecosimu(comm, function(x) tcrossprod(x)[tri], method = null, nsimul = nsimul, - alternative = if (chase) "greater" else "less") + alternative = if (chase) "less" else "greater") ## Chase et al. way, or the standard way if (chase) out <- 1 - sol$oecosimu$pval Modified: branches/2.0/inst/ChangeLog =================================================================== --- branches/2.0/inst/ChangeLog 2013-07-09 13:22:12 UTC (rev 2545) +++ branches/2.0/inst/ChangeLog 2013-07-09 13:32:28 UTC (rev 2546) @@ -11,7 +11,9 @@ * merge r2534: lwd in ordisurf. * merge r2533: ordipointlabel uses ordiArgAbsorber. * merge r2504: notation in adipart.Rd. + * merge r2498: adapt raupcrick to r2495. * merge r2497: avoid visible ~ in .Rnw. + * merge r2495: fix twisted test direction in oecosimu. * merge r2490 thru 2493: ordisurf new options. * merge r2484 thru 2486: betadisper fixes (centroid with one group, call it medoid). Modified: branches/2.0/man/oecosimu.Rd =================================================================== --- branches/2.0/man/oecosimu.Rd 2013-07-09 13:22:12 UTC (rev 2545) +++ branches/2.0/man/oecosimu.Rd 2013-07-09 13:32:28 UTC (rev 2546) @@ -251,7 +251,11 @@ ## Use the first eigenvalue of correspondence analysis as an index ## of structure: a model for making your own functions. data(sipoo) -out <- oecosimu(sipoo, decorana, "swap", burnin=100, thin=10, statistic="evals") +## Traditional nestedness statistics (number of checkerboard units) +oecosimu(sipoo, nestedchecker, "r0") +## sequential model, one-sided test, a vector statistic +out <- oecosimu(sipoo, decorana, "swap", burnin=100, thin=10, + statistic="evals", alt = "greater") out ## Inspect the swap sequence as a time series object plot(as.ts(out)) From noreply at r-forge.r-project.org Tue Jul 9 15:54:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 15:54:12 +0200 (CEST) Subject: [Vegan-commits] r2547 - branches/2.0/inst www Message-ID: <20130709135412.C9EFD185127@r-forge.r-project.org> Author: jarioksa Date: 2013-07-09 15:54:12 +0200 (Tue, 09 Jul 2013) New Revision: 2547 Modified: branches/2.0/inst/NEWS.Rd www/NEWS.html Log: NEWS about 2.0-8 Modified: branches/2.0/inst/NEWS.Rd =================================================================== --- branches/2.0/inst/NEWS.Rd 2013-07-09 13:32:28 UTC (rev 2546) +++ branches/2.0/inst/NEWS.Rd 2013-07-09 13:54:12 UTC (rev 2547) @@ -2,8 +2,40 @@ \title{vegan News} \encoding{UTF-8} -\section{Changes in version 2.0.7}{ +\section{Changes in version 2.0-8}{ + \subsection{GENERAL}{ + \itemize{ + + \item This is a maintenance release that fixes some issues + raised by changed in \R{} toolset for processing vignettes. In + the same we also fix some typographic issues in the vignettes. + + } + } % general + + \subsection{NEW FEATURES}{ + \itemize{ + + \item \code{ordisurf} gained new arguments for more flexible + definition of fitted models to better utilize the + \pkg{mgcv}\code{::gam} function. The linewidth of contours can + now be set with the argument \code{lwd}. + + \item Labels to arrows are more cleanly positioned in + \code{plot} functions for the results of \code{envfit}, + \code{cca}, \code{rda} and \code{capscale}. + + \item The wording for setting test direction is now clearer in + \code{oecosimu}. + + } + } % new features + +} + +\section{Changes in version 2.0-7}{ + \subsection{NEW FUNCTIONS}{ \itemize{ Modified: www/NEWS.html =================================================================== --- www/NEWS.html 2013-07-09 13:32:28 UTC (rev 2546) +++ www/NEWS.html 2013-07-09 13:54:12 UTC (rev 2547) @@ -8,16 +8,54 @@

vegan News

-

Changes in version 2.0.7

+

Changes in version 2.0-8

+

GENERAL

-

NEW FUNCTIONS

+ + + +

NEW FEATURES

+ + + + + + +

Changes in version 2.0-7

+ + + +

NEW FUNCTIONS

+ + +