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

[noreply at r-forge.r-project.org]

Author: jarioksa
Date: 2012-08-31 06:33:21 +0200 (Fri, 31 Aug 2012)
New Revision: 2261

Modified:
   pkg/vegan/NAMESPACE
   pkg/vegan/R/density.anosim.R
   pkg/vegan/R/density.oecosimu.R
   pkg/vegan/inst/ChangeLog
Log:
add plot.vegandensity() 

vegan density() functions now return an object of classes
c("vegandensity", "density") that also contains the observed
statistic, and plot.vegandensity() plots the density plus a line
for the observed statistic (optionally).


Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE	2012-08-26 17:27:36 UTC (rev 2260)
+++ pkg/vegan/NAMESPACE	2012-08-31 04:33:21 UTC (rev 2261)
@@ -264,6 +264,7 @@
 S3method(plot, taxondive)
 S3method(plot, varpart)
 S3method(plot, varpart234)
+S3method(plot, vegandensity)
 # points: graphics
 S3method(points, cca)
 S3method(points, decorana)

Modified: pkg/vegan/R/density.anosim.R
===================================================================
--- pkg/vegan/R/density.anosim.R	2012-08-26 17:27:36 UTC (rev 2260)
+++ pkg/vegan/R/density.anosim.R	2012-08-31 04:33:21 UTC (rev 2261)
@@ -10,7 +10,9 @@
 {
     out <- density(x$perm, ...)
     out$call <- match.call()
+    out$observed <- x$statistic
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 
@@ -23,8 +25,10 @@
     if (cols > 1)
         warning("'density' is meaningful only with one term, you have ", cols)
     out <- density(x$f.perms, ...)
+    out$observed <- x$aov.tab$F.Model
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 
@@ -50,8 +54,10 @@
     function(x, ...)
 {
     out <- density(x$perm, ...)
+    out$observed <- x$statistic
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 
@@ -61,8 +67,10 @@
     function(x, ...)
 {
     out <- density(x$boot.deltas, ...)
+    out$observed <- x$delta
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 
@@ -74,8 +82,10 @@
     function(x, ...)
 {
     out <- density(x$F.perm, ...)
+    out$observed <- x$F.0
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 
@@ -85,7 +95,44 @@
     function(x, ...)
 {
     out <- density(x$t, ...)
+    out$observed <- x$t0
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
+
+#### plot method: the following copies stats::plot.density() code but
+#### adds one new argument to draw abline(v=...) for the observed
+#### statistic
+
+`plot.vegandensity` <-
+    function (x, main = NULL, xlab = NULL, ylab = "Density", type = "l", 
+    zero.line = TRUE, obs.line = FALSE, ...) 
+{
+    if (is.null(xlab)) 
+        xlab <- paste("N =", x$n, "  Bandwidth =", formatC(x$bw))
+    if (is.null(main)) 
+        main <- deparse(x$call)
+    ## adjust xlim of obs.line if needed
+    if (obs.line) {
+        xlim <- range(c(x$x, x$observed), na.rm = TRUE)
+        ## change obs.line to col=2 (red) if it was logical TRUE
+        if (isTRUE(obs.line))
+            obs.line <- 2
+    } else {
+        xlim <- NULL
+    }
+    ## check for explicit xlim in the call and use it if specified
+    if(!is.null(match.call(expand.dots = FALSE)$...$xlim))
+        plot.default(x, main = main, xlab = xlab, ylab = ylab, type = type,
+                     ...)
+    else
+        plot.default(x, main = main, xlab = xlab, ylab = ylab, type = type,
+                     xlim = xlim, ...)
+    if (zero.line) 
+        abline(h = 0, lwd = 0.1, col = "gray")
+    if (obs.line)
+        abline(v = x$observed, col = obs.line)
+    invisible(NULL)
+}

Modified: pkg/vegan/R/density.oecosimu.R
===================================================================
--- pkg/vegan/R/density.oecosimu.R	2012-08-26 17:27:36 UTC (rev 2260)
+++ pkg/vegan/R/density.oecosimu.R	2012-08-31 04:33:21 UTC (rev 2261)
@@ -5,8 +5,10 @@
     if (cols > 1)
         warning("'density' is meaningful only with one statistic, you have ", cols)
     out <- density(t(x$oecosimu$simulated), ...)
+    out$observed <- x$oecosimu$statistic
     out$call <- match.call()
     out$call[[1]] <- as.name("density")
+    class(out) <- c("vegandensity", class(out))
     out
 }
 

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2012-08-26 17:27:36 UTC (rev 2260)
+++ pkg/vegan/inst/ChangeLog	2012-08-31 04:33:21 UTC (rev 2261)
@@ -22,9 +22,12 @@
  
 	* density methods: all vegan functions that return simulated or
 	permuted statistics have now density() methods that directly
-	access the returned statistic. The functions can be used to plot
-	the empirical distribution of the statistics with
-	plot(density(<vegan-object>)). 
+	access the returned statistic. The functions return an object of
+	class "vegandensity" that inherits from class "density". The
+	object is identical to class "density", but it is amended with
+	item "observed" that contains the observed statistic. It has a
+	plot.vegandensity() function that is similar to plot.density(),
+	but it also draws a vertical line for the observed statistic.
 
 	The density methods were made available for adonis, anosim,
 	mantel & partial.mantel, mrpp, permutest.cca and procrustes. The