[Vegan-commits] r2927 - in pkg/vegan: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 22 12:31:36 CET 2015


Author: jarioksa
Date: 2015-01-22 12:31:36 +0100 (Thu, 22 Jan 2015)
New Revision: 2927

Modified:
   pkg/vegan/DESCRIPTION
   pkg/vegan/R/showvarparts.R
   pkg/vegan/man/varpart.Rd
Log:
Merge branch 'cran-2.2' into r-forge-svn-local

Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION	2015-01-09 07:53:53 UTC (rev 2926)
+++ pkg/vegan/DESCRIPTION	2015-01-22 11:31:36 UTC (rev 2927)
@@ -1,6 +1,6 @@
 Package: vegan
 Title: Community Ecology Package
-Version: 2.2-1
+Version: 2.2-2
 Date: 2015-01-12
 Author: Jari Oksanen, F. Guillaume Blanchet, Roeland Kindt, Pierre Legendre, 
    Peter R. Minchin, R. B. O'Hara, Gavin L. Simpson, Peter Solymos, 

Modified: pkg/vegan/R/showvarparts.R
===================================================================
--- pkg/vegan/R/showvarparts.R	2015-01-09 07:53:53 UTC (rev 2926)
+++ pkg/vegan/R/showvarparts.R	2015-01-22 11:31:36 UTC (rev 2927)
@@ -1,24 +1,74 @@
-"showvarparts" <-
-function(parts = 2, labels, ...)
+`showvarparts` <-
+    function(parts, labels, bg = NULL, alpha=63, Xnames, id.size=1.2, ...)
 {
     rad <- 0.725
+    ## Default names
+    if (missing(Xnames))
+        Xnames <- paste("X", seq_len(parts), sep="")
+    ## transparent fill colours
+    if (!is.null(bg)) {
+        bg <- rgb(t(col2rgb(bg)), alpha = alpha, maxColorValue = 255)
+        if (length(bg) < parts)
+            bg <- rep(bg, length.out = parts)
+    }
+    ## centroids of circles (parts < 4) or individual fractions (parts
+    ## == 4)
     cp <- switch(parts,
-                 c(0,0),
-                 c(0,0, 1,0),
-                 c(0,0, 1,0, 0.5, -sqrt(3/4)),
-                 c(-0.5,0.3, 0.5, 0.3, 0, -sqrt(3/4)+0.3)
+                 matrix(c(0,0), ncol=2, byrow=TRUE),
+                 matrix(c(0,0, 1,0), ncol=2, byrow=TRUE),
+                 matrix(c(0,0, 1,0, 0.5, -sqrt(3/4)), ncol=2, byrow=TRUE),
+                 structure(
+                     c(-1.2, -0.6, 0.6, 1.2, -0.7, 0, -0.7, 0, 0.7, 0.7,
+                       0.3, -0.4, 0.4, -0.3, 0, 0, 0.7, 0.7, 0, 0.3, 0.4,
+                       -0.6,-1.2, -0.6, 0.3, -0.7, 0, 0, -0.7, -0.4),
+                     .Dim = c(15L, 2L))
                  )
-    cp <- matrix(cp, ncol=2, byrow=TRUE)
+    ## plot limits
+    if (parts < 4) {
+        xlim <- range(cp[,1]) + c(-rad, rad)
+        ylim <- range(cp[,2]) + c(-rad, rad)
+    } else {
+        xlim <- c(-1.7, 1.7)
+        ylim <- c(-1.7, 1.1)
+    }
+    ## plot
     plot(cp, axes=FALSE, xlab="", ylab="", asp=1, type="n", 
-         xlim = (range(cp[,1]) + c(-rad, rad)),
-         ylim = (range(cp[,2]) + c(-rad, rad)))
+         xlim = xlim, ylim = ylim)
     box()
-    symbols(cp, circles = rep(rad, min(parts,3)), inches = FALSE, add=TRUE, ...)
-    if (parts == 4) {
-        symbols(0, 0.2, rectangles=cbind(1, 0.5), inches=FALSE, add=TRUE, ...)
-        symbols(sqrt(1/2), -sqrt(3/4)+0.2, rectangles=cbind(0.5,0.3),
-                inches=FALSE, add=TRUE, ...)
+    if (parts < 4) {
+        symbols(cp, circles = rep(rad, min(parts,3)), inches = FALSE,
+                add=TRUE, bg = bg, ...)
+        ## Explanatory data set names added by PL
+        if(parts==2) {
+            pos.names = matrix(c(-0.65,1.65,0.65,0.65),2,2)
+        } else if(parts==3) {
+            pos.names = matrix(c(-0.65,1.65,-0.16,0.65,0.65,-1.5),3,2)
+        }
+        text(pos.names,labels=Xnames[1:parts], cex=id.size)
+    } else {
+        ## Draw ellipses with veganCovEllipse. Supply 2x2
+        ## matrix(c(d,a,a,d), 2, 2) which defines an ellipse of
+        ## semi-major axis length sqrt(d+a) semi-minor axis sqrt(d-a).
+        d <- 1
+        a <- 1/sqrt(2)
+        ## Small ellipses X2, X3 at the centroid
+        e2 <- veganCovEllipse(matrix(c(d,-a,-a,d), 2, 2))
+        e3 <- veganCovEllipse(matrix(c(d, a, a,d), 2, 2))
+        ## wider ellipses X1, X4 at sides going through the centroid
+        L <- d+a
+        W <- (sqrt(L) - sqrt(d-a))^2
+        d <- (L+W)/2
+        a <- (L-W)/2
+        cnt <- sqrt(W/2)
+        e1 <- veganCovEllipse(matrix(c(d,-a,-a,d), 2, 2), c(-cnt, -cnt))
+        e4 <- veganCovEllipse(matrix(c(d, a, a,d), 2, 2), c( cnt, -cnt))
+        polygon(rbind(e1,NA,e2,NA,e3,NA,e4), col = bg, ...)
+        ## Explanatory data set names added by PL
+        pos.names = matrix(c(-1.62,-1.10,1.10,1.62,0.54,1.00,1.00,0.54),4,2)
+        text(pos.names,labels=Xnames[1:4], cex=id.size)
     }
+    
+    ## label fractions
     nlabs <- switch(parts, 2, 4, 8, 16)
     if (missing(labels))
         labels <- paste("[", letters[1:nlabs], "]", sep="")
@@ -29,19 +79,10 @@
            text(rbind(cp[1,], colMeans(cp), cp[2,]), labels[-nlabs], ...),
            text(rbind(cp, colMeans(cp[1:2,]), colMeans(cp[2:3,]),
                       colMeans(cp[c(1,3),]), colMeans(cp)), labels[-nlabs], ...),
-           text(rbind(1.4*cp, c(0.8, -sqrt(3/4)+0.2),
-                      colMeans(cp[1:2,]) + c(0,0.25),
-                      colMeans(cp[2:3,]), colMeans(cp[c(1,3),]),
-                      cp[1,] + c(0.1,0), cp[2,] -c(0.1,0),
-                      c(0.6, -sqrt(3/4)+0.2), colMeans(cp[1:2,]),
-                      colMeans(cp)-c(0,0.12), colMeans(cp[2:3,]) + c(0,0.14),
-                      colMeans(cp[c(1,3),]) + c(0, 0.14),
-                      colMeans(cp) + c(0,0.08)),
-                labels[-nlabs], ...)
+           text(cp, labels[-nlabs], ...)
            )
     xy <- par("usr")
     text(xy[2] - 0.05*diff(xy[1:2]), xy[3] + 0.05*diff(xy[3:4]),
          paste("Residuals =", labels[nlabs]), pos = 2, ...)
     invisible()
 }
-

Modified: pkg/vegan/man/varpart.Rd
===================================================================
--- pkg/vegan/man/varpart.Rd	2015-01-09 07:53:53 UTC (rev 2926)
+++ pkg/vegan/man/varpart.Rd	2015-01-22 11:31:36 UTC (rev 2927)
@@ -21,7 +21,8 @@
 
 \usage{
 varpart(Y, X, ..., data, transfo, scale = FALSE)
-showvarparts(parts, labels, ...)
+showvarparts(parts, labels, bg = NULL, alpha = 63, Xnames,
+    id.size = 1.2,  ...)
 \method{plot}{varpart234}(x, cutoff = 0, digits = 1, ...)
 }
 
@@ -53,6 +54,21 @@
 \item{parts}{Number of explanatory tables (circles) displayed.}
 \item{labels}{Labels used for displayed fractions. Default is to use
   the same letters as in the printed output.}
+\item{bg}{Fill colours of circles or ellipses.}
+\item{alpha}{Transparency of the fill colour.  The argument takes
+    precedence over possible transparency definitions of the
+    colour. The value must be in range \eqn{0...255}, and low values
+    are more transparent.  Transparency is not available in all
+    graphics devices or file formats.}
+  
+\item{Xnames}{Names for sources of variation. Default names are \code{X1},
+  \code{X2}, \code{X3} and \code{X4}. \code{Xnames=NA},
+  \code{Xnames=NULL} and \code{Xnames=""} produce no names. The names
+  can be changed to other names. Use short names. }
+
+\item{id.size}{A numerical value giving the character expansion factor
+  for the names of circles or ellipses. }
+
 \item{x}{The \code{varpart} result.}
 \item{cutoff}{The values below \code{cutoff} will not be displayed.}
 \item{digits}{The number of significant digits; the number of decimal
@@ -113,10 +129,17 @@
   \code{[n]}, and the joint fraction between all four tables is
   \code{[o]}.
 
-  There is a \code{plot} function that displays the Venn
-  diagram and labels each intersection (individual fraction) with the
-  adjusted R squared if this is higher than \code{cutoff}.  A helper
-  function \code{showvarpart} displays the fraction labels.
+  There is a \code{plot} function that displays the Venn diagram and
+  labels each intersection (individual fraction) with the adjusted R
+  squared if this is higher than \code{cutoff}.  A helper function
+  \code{showvarpart} displays the fraction labels. The circles and
+  ellipses are labelled by short default names or by names defined by
+  the user in argument \code{Xnames}. Longer explanatory file names can
+  be written on the varpart output plot as follows: use option
+  \code{Xnames=NA}, then add new names using the \code{text} function. A
+  bit of fiddling with coordinates (see \code{\link{locator}}) and
+  character size should allow users to place names of reasonably short
+  lengths on the \code{varpart} plot.
   
 }
 
@@ -239,11 +262,9 @@
 mod <- varpart(mite, ~ ., mite.pcnm, data=mite.env, transfo="hel")
 mod
 
-## argument 'bg' is passed to circle drawing, and the following
-## defines semitransparent colours
-col2 <- rgb(c(1,1),c(1,0), c(0,1), 0.3)
-showvarparts(2, bg = col2)
-plot(mod, bg = col2)
+## Use fill colours
+showvarparts(2, bg = c("hotpink","skyblue"))
+plot(mod, bg = c("hotpink","skyblue"))
 # Alternative way of to conduct this partitioning
 # Change the data frame with factors into numeric model matrix
 mm <- model.matrix(~ SubsDens + WatrCont + Substrate + Shrub + Topo, mite.env)[,-1]
@@ -258,8 +279,8 @@
 mod <- varpart(mite, ~ SubsDens + WatrCont, ~ Substrate + Shrub + Topo,
    mite.pcnm, data=mite.env, transfo="hel")
 mod
-showvarparts(3)
-plot(mod)
+showvarparts(3, bg=2:4)
+plot(mod, bg=2:4)
 # An alternative formulation of the previous model using
 # matrices mm1 amd mm2 and Hellinger transformed species data
 mm1 <- model.matrix(~ SubsDens + WatrCont, mite.env)[,-1]
@@ -276,9 +297,9 @@
 mod <- varpart(mite, ~ SubsDens + WatrCont, ~Substrate + Shrub + Topo,
   mite.pcnm[,1:11], mite.pcnm[,12:22], data=mite.env, transfo="hel")
 mod
-plot(mod)
+plot(mod, bg=2:5)
 # Show values for all partitions by putting 'cutoff' low enough:
-plot(mod, cutoff = -Inf, cex = 0.7)
+plot(mod, cutoff = -Inf, cex = 0.7, bg=2:5)
 }
 
 \keyword{ multivariate }



More information about the Vegan-commits mailing list