Merge branch 'issue-682': closes #682

R/add1.cca.R

@@ -8,7 +8,8 @@
         stop("ordination model must be fitted using formula")
     test <- match.arg(test)
     ## Default add1
-    out <- NextMethod("add1", object, test = "none", ...)
+    # don't show messages about aliased terms
+    out <- suppressMessages(NextMethod("add1", object, test = "none", ...))
     cl <- class(out)
     ## Loop over terms in 'scope' and do anova.cca
     if (test == "permutation") {

R/anova.ccabyterm.R

@@ -90,9 +90,11 @@
         stop("old style result object: update() your model")
     ## analyse only terms of 'ass' thar are in scope
     scopeterms <- which(alltrms %in% trmlab)
-    mods <- lapply(scopeterms, function(i, ...)
-           permutest(ordConstrained(Y, X[, ass != i, drop=FALSE], Z, "pass"),
-                     permutations, ...), ...)
+    mods <- suppressMessages(
+        lapply(scopeterms, function(i, ...)
+            permutest(ordConstrained(Y, X[, ass != i, drop = FALSE], Z, "pass"),
+                permutations, ...), ...)
+    )
     ## Chande in df
     Df <- sapply(mods, function(x) x$df[2]) - dfbig
     ## F of change
@@ -197,7 +199,9 @@
     F.perm <- matrix(ncol = ncol(LC), nrow = nperm)
     for (i in seq_along(eig)) {
         if (i > 1) {
-            object <- ordConstrained(Y, X, cbind(Z, LC[, seq_len(i-1)]), "pass")
+            object <- suppressMessages(
+                ordConstrained(Y, X, cbind(Z, LC[, seq_len(i - 1)]), "pass")
+            )
         }
         if (length(eig) == i) {
             mod <- permutest(object, permutations, model = model,

R/drop1.cca.R

@@ -7,7 +7,8 @@
     if (is.null(object$terms))
         stop("ordination model must be fitted using formula")
     test <- match.arg(test)
-    out <- NextMethod("drop1", object, test="none", ...)
+    # don't show messages about aliased terms
+    out <- suppressMessages(NextMethod("drop1", object, test = "none", ...))
     cl <- class(out)
     if (test == "permutation") {
         rn <- rownames(out)[-1]

R/ordConstrained.R

@@ -199,8 +199,19 @@
     if (rank == 0)
         return(list(Y = Y, result = NULL))
     ## check for aliased terms
-    if (length(Q$pivot) > Q$rank)
+    if (length(Q$pivot) > Q$rank) {
         alias <- colnames(Q$qr)[-seq_len(Q$rank)]
+        # print a message to highlight this aliasing
+        #msg <- "Some model terms were linearly dependent and their effects
+#cannot be uniquely estimated. See '?alias.cca' for more detail and use
+#'vif.cca()' to identify these terms."
+        #message(strwrap(msg, prefix = "\n", initial = "\n",
+        #    width = 0.95 * getOption("width")))
+        aliased <- paste(sQuote(alias), collapse = ", ")
+        msg <- paste("Some constraints or conditions were aliased because they were redundant.",
+        "This can happen if terms are linearly dependent (collinear):", aliased)
+        message(strwrap(msg, width = getOption("width"), prefix = "\n", initial = "\n"))
+    }
     else
         alias <- NULL
     ## kept constraints and their means
@@ -418,9 +429,11 @@
     }
     ## Residuals
     resid <- ordResid(Y)
-    if (resid$rank < 1)
-        warning("overfitted model with no unconstrained component",
-                call. = FALSE)
+    if (resid$rank < 1) {
+        msg <- "The model is overfitted with no unconstrained (residual) component"
+        message(strwrap(msg, prefix = "\n", initial = "\n",
+            width = 0.95 * getOption("width")))
+    }
     ## return a CCA object
     out <- c(head,
              call = match.call(),

R/print.cca.R

@@ -1,7 +1,9 @@
 `print.cca` <-
     function (x, digits = max(3, getOption("digits") - 3), ...)
 {
-    writeLines(strwrap(pasteCall(x$call)))
+    ord_obj <- deparse(substitute(x))
+    msg_w <- 0.95 * getOption("width")
+    writeLines(strwrap(pasteCall(x$call), width = msg_w))
     cat("\n")
     if (!is.null(x$CA$imaginary.chi))
         totchi <- x$tot.chi - x$CA$imaginary.chi
@@ -37,22 +39,46 @@
         tbl <- tbl[,-2]
     ## 'cs' columns before "Rank" are non-integer
     cs <- which(colnames(tbl) == "Rank") - 1
+    writeLines("-- Model Summary --\n")
     printCoefmat(tbl, digits = digits, na.print = "", cs.ind = seq_len(cs))
-    cat("Inertia is", x$inertia, "\n")
-    ## data used for species scores in db ordination
-    if (!is.null(x$vdata))
-        cat("Species scores projected from", sQuote(x$vdata), "\n")
-    if (!is.null(x$CCA$alias))
-        cat("Some constraints or conditions were aliased because they were redundant\n")
-    ## Report removed observations and species
-    if (!is.null(x$na.action))
-        cat(naprint(x$na.action), "\n")
+    writeLines(strwrap(paste("Inertia is", x$inertia), width = msg_w,
+        initial = "\n"))
     sp.na <- if (is.null(x$CCA)) attr(x$CA$v, "na.action")
     else attr(x$CCA$v, "na.action")
-    if (!is.null(sp.na))
-        cat(length(sp.na), "species",
-            ifelse(length(sp.na)==1, "(variable)", "(variables)"),
-            "deleted due to missingness\n")
+    # print any notices
+    if (any(!is.null(x$vdata), !is.null(x$CCA$alias), x$CA$rank < 1,
+        !is.null(x$na.action), !is.null(sp.na))) {
+        writeLines("\n-- Note --")
+    }
+    ## data used for species scores in db ordination
+    if (!is.null(x$vdata)) {
+        writeLines(
+            strwrap(paste("Species scores projected from", sQuote(x$vdata)),
+                width = msg_w, initial = "\n")
+        )
+    }
+    # notify if any terms are linearly dependent (aliased)
+    if (!is.null(x$CCA$alias)) {
+        vif_msg <- sQuote(paste0("vif.cca(", ord_obj, ")"))
+        aliased <- paste(sQuote(alias(x, names.only = TRUE)), collapse = ", ")
+        msg <- paste("Some constraints or conditions were aliased because they were redundant.",
+        "This can happen if terms are linearly dependent (collinear):", aliased)
+        writeLines(strwrap(msg, width = msg_w, initial = "\n"))
+    }
+    if (x$CA$rank < 1) {
+        msg <- "The model is overfitted with no unconstrained (residual) component."
+        writeLines(strwrap(msg, width = msg_w, initial = "\n"))
+    }
+    ## Report removed observations and species
+    if (!is.null(x$na.action)) {
+        writeLines(strwrap(naprint(x$na.action), width = msg_w, initial = "\n"))
+    }
+    if (!is.null(sp.na)) {
+        writeLines(strwrap(paste(length(sp.na), "species",
+            ifelse(length(sp.na) == 1, "(variable)", "(variables)"),
+            "deleted due to missingness."), width = msg_w, initial = "\n"))
+    }
+    writeLines("\n-- Eigenvalues --")
     if (!is.null(x$CCA) && x$CCA$rank > 0) {
         cat("\nEigenvalues for constrained axes:\n")
         print(zapsmall(x$CCA$eig, digits = digits), ...)

man/plot.cca.Rd

@@ -160,7 +160,7 @@
   object may contain scores with names
   \Sexpr[results=rd,stage=build]{require(vegan, quietly=TRUE);
     data(dune, dune.env);
-    noquote(paste0(sQuote(names(scores(rda(dune ~ ., dune.env)))),
+    noquote(paste0(sQuote(names(scores(rda(dune ~ Moisture, dune.env)))),
     collapse=", "))}
   (some of these may be missing depending on your model and are only
   available if given in \code{display}). The first