[Vegan-commits] r2904 - pkg/vegan/R

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

Author: jarioksa
Date: 2014-10-23 11:18:30 +0200 (Thu, 23 Oct 2014)
New Revision: 2904

Modified:
   pkg/vegan/R/plot.cca.R
Log:
Squashed commit of the following:

commit 40fef9d21093a5f2a2ce65b2ca5f9f6eda7c3792
Merge: 05ced8c f445e14
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date:   Thu Oct 23 12:15:00 2014 +0300

    Merge pull request #62 from gavinsimpson/fix-plot-limits-issue

    extract all scores when setting x and y limits for plot

Modified: pkg/vegan/R/plot.cca.R
===================================================================
--- pkg/vegan/R/plot.cca.R	2014-10-22 08:26:22 UTC (rev 2903)
+++ pkg/vegan/R/plot.cca.R	2014-10-23 09:18:30 UTC (rev 2904)
@@ -1,12 +1,12 @@
 `plot.cca` <-
-    function (x, choices = c(1, 2), display = c("sp", "wa", "cn"), 
-              scaling = 2, type, xlim, ylim,  const, ...) 
+    function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
+              scaling = 2, type, xlim, ylim,  const, ...)
 {
     TYPES <- c("text", "points", "none")
     g <- scores(x, choices, display, scaling, const)
     if (length(g) == 0 || all(is.na(g)))
       stop("nothing to plot: requested scores do not exist")
-    if (!is.list(g)) 
+    if (!is.list(g))
         g <- list(default = g)
     ## Take care that there are names
     for (i in seq_len(length(g))) {
@@ -15,20 +15,20 @@
                                          prefix = substr(names(g)[i], 1, 3))
     }
     if (!is.null(g$centroids)) {
-        if (is.null(g$biplot)) 
+        if (is.null(g$biplot))
             g$biplot <- scores(x, choices, "bp", scaling)
         if (!is.na(g$centroids)[1]) {
             bipnam <- rownames(g$biplot)
             cntnam <- rownames(g$centroids)
             g$biplot <- g$biplot[!(bipnam %in% cntnam), , drop = FALSE]
-            if (nrow(g$biplot) == 0) 
+            if (nrow(g$biplot) == 0)
                 g$biplot <- NULL
         }
     }
     if (missing(type)) {
         nitlimit <- 80
         nit <- max(nrow(g$spe), nrow(g$sit), nrow(g$con), nrow(g$def))
-        if (nit > nitlimit) 
+        if (nit > nitlimit)
             type <- "points"
         else type <- "text"
     }
@@ -53,36 +53,44 @@
             }
         return(invisible(pl))
     }
-    if (missing(xlim))
-        xlim <- range(g$spe[, 1], g$sit[, 1], g$con[, 1], g$default[,1],
+    if (missing(xlim)) {
+        xlim <- range(g$species[, 1], g$sites[, 1], g$constraints[, 1],
+                      g$biplot[, 1],
+                      if (length(g$centroids) > 0 && is.na(g$centroids)) NA else g$centroids[, 1],
+                      g$default[, 1],
                       na.rm = TRUE)
+    }
     if (!any(is.finite(xlim)))
         stop("no finite scores to plot")
-    if (missing(ylim))
-        ylim <- range(g$spe[, 2], g$sit[, 2], g$con[, 2], g$default[,2],
+    if (missing(ylim)) {
+        ylim <- range(g$species[, 2], g$sites[, 2], g$constraints[, 2],
+                      g$biplot[, 2],
+                      if (length(g$centroids) > 0 && is.na(g$centroids)) NA else g$centroids[, 2],
+                      g$default[, 2],
                       na.rm = TRUE)
-    plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1, 
+    }
+    plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1,
          ...)
     abline(h = 0, lty = 3)
     abline(v = 0, lty = 3)
     if (!is.null(g$species)) {
-        if (type == "text") 
-            text(g$species, rownames(g$species), col = "red", 
+        if (type == "text")
+            text(g$species, rownames(g$species), col = "red",
                  cex = 0.7)
-        else if (type == "points") 
+        else if (type == "points")
             points(g$species, pch = "+", col = "red", cex = 0.7)
     }
     if (!is.null(g$sites)) {
-        if (type == "text") 
+        if (type == "text")
             text(g$sites, rownames(g$sites), cex = 0.7)
-        else if (type == "points") 
+        else if (type == "points")
             points(g$sites, pch = 1, cex = 0.7)
     }
     if (!is.null(g$constraints)) {
-        if (type == "text") 
-            text(g$constraints, rownames(g$constraints), cex = 0.7, 
+        if (type == "text")
+            text(g$constraints, rownames(g$constraints), cex = 0.7,
                  col = "darkgreen")
-        else if (type == "points") 
+        else if (type == "points")
             points(g$constraints, pch = 2, cex = 0.7, col = "darkgreen")
     }
     if (!is.null(g$biplot) && nrow(g$biplot) > 0 && type != "none") {
@@ -91,24 +99,24 @@
         }
         else mul <- 1
         attr(g$biplot, "arrow.mul") <- mul
-        arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2], 
+        arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2],
                length = 0.05, 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")
     }
-    if (!is.null(g$centroids) && !is.na(g$centroids) && type != 
+    if (!is.null(g$centroids) && !is.na(g$centroids) && type !=
         "none") {
-        if (type == "text") 
+        if (type == "text")
             text(g$centroids, rownames(g$centroids), col = "blue")
-        else if (type == "points") 
+        else if (type == "points")
             points(g$centroids, pch = "x", col = "blue")
     }
     if (!is.null(g$default) && type != "none") {
-        if (type == "text") 
+        if (type == "text")
             text(g$default, rownames(g$default), cex = 0.7)
-        else if (type == "points") 
+        else if (type == "points")
             points(g$default, pch = 1, cex = 0.7)
     }
     class(g) <- "ordiplot"