From 0f4cf0c2bec803ef98745442fe8034b090919499 Mon Sep 17 00:00:00 2001
From: Jari Oksanen <jari.oksanen@oulu.fi>
Date: Tue, 20 Sep 2016 11:59:42 +0300
Subject: [PATCH 1/4] dbrda/capscale needs Yhat <- qr.fitted(Q, t(qr.fitted(Q,
 Y)))

---
 R/permutest.cca.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/permutest.cca.R b/R/permutest.cca.R
index 110f42a2..f8ce440e 100644
--- a/R/permutest.cca.R
+++ b/R/permutest.cca.R
@@ -66,6 +66,8 @@ permutest.default <- function(x, ...)
                 Q <- qr(XY)
             }
             tmp <- qr.fitted(Q, Y)
+            if (isDB)
+                tmp <- qr.fitted(Q, t(tmp))
             if (first)
                 if (isDB)
                     cca.ev <- eigen(tmp)$values[1]

From 346ea39a7232c5ff0bb992c0dce3a044b143aaa1 Mon Sep 17 00:00:00 2001
From: Jari Oksanen <jari.oksanen@oulu.fi>
Date: Tue, 20 Sep 2016 12:07:10 +0300
Subject: [PATCH 2/4] dbrda/capscale need Yres <- qr.resid(Q, t(qr.resid(Q,
 Y)))

suggested fix to github issue #198: permutest (and hence anova)
failed when first=TRUE was requested
---
 R/permutest.cca.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/permutest.cca.R b/R/permutest.cca.R
index f8ce440e..0706f484 100644
--- a/R/permutest.cca.R
+++ b/R/permutest.cca.R
@@ -57,6 +57,8 @@ permutest.default <- function(x, ...)
                     QZ <- qr(XZ)
                 }
                 Y <- qr.resid(QZ, Y)
+                if (isDB)
+                    Y <- qr.resid(QZ, t(Y))
             }
             if (isCCA) {
                 XY <- .C("wcentre", x = as.double(X), as.double(wtake),

From daa34e6f6da867e2a36a3a2fdf7deddfe96f6779 Mon Sep 17 00:00:00 2001
From: Jari Oksanen <jari.oksanen@oulu.fi>
Date: Wed, 21 Sep 2016 09:45:30 +0300
Subject: [PATCH 3/4] first eigenvalue cannot be analysed in capscale with
 imaginary components

cast to oldCapscale (with message) and use old non-distance-based
analysis.
---
 R/permutest.cca.R | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/R/permutest.cca.R b/R/permutest.cca.R
index 0706f484..d9a44d4f 100644
--- a/R/permutest.cca.R
+++ b/R/permutest.cca.R
@@ -24,6 +24,10 @@ permutest.default <- function(x, ...)
     ## special cases
     isCCA <- !inherits(x, "rda")    # weighting
     isPartial <- !is.null(x$pCCA)   # handle conditions
+    ## first eigenvalue cannot be analysed with capscale which had
+    ## discarded imaginary values: cast to old before evaluating isDB
+    if (first && inherits(x, "capscale"))
+        x <- oldCapscale(x)
     isDB <- inherits(x, c("capscale", "dbrda")) &&
         !inherits(x, "oldcapscale")  # distance-based & new design
     ## Function to get the F statistics in one loop
@@ -87,6 +91,7 @@ permutest.default <- function(x, ...)
         mat
     }
     ## end getF()
+
     if (first) {
         Chi.z <- x$CCA$eig[1]
         q <- 1

From c76a1bebffec1298d753d359832eec0e57e5dc9c Mon Sep 17 00:00:00 2001
From: Jari Oksanen <jari.oksanen@oulu.fi>
Date: Wed, 21 Sep 2016 10:04:21 +0300
Subject: [PATCH 4/4] eigen spent most of its time in checking if matrix was
 symmetric

now we guarantee a symmetric input and tell eigen() that
symmetric = TRUE, and permutest(<dbrda-object>, first=TRUE) is
almost 2x faster.
---
 R/permutest.cca.R | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/R/permutest.cca.R b/R/permutest.cca.R
index d9a44d4f..5716fdc5 100644
--- a/R/permutest.cca.R
+++ b/R/permutest.cca.R
@@ -72,14 +72,13 @@ permutest.default <- function(x, ...)
                 Q <- qr(XY)
             }
             tmp <- qr.fitted(Q, Y)
-            if (isDB)
-                tmp <- qr.fitted(Q, t(tmp))
-            if (first)
-                if (isDB)
-                    cca.ev <- eigen(tmp)$values[1]
-                else
+            if (first) {
+                if (isDB) {
+                    tmp <- qr.fitted(Q, t(tmp)) # eigen needs symmetric tmp
+                    cca.ev <- eigen(tmp, symmetric = TRUE)$values[1]
+                } else
                     cca.ev <- La.svd(tmp, nv = 0, nu = 0)$d[1]^2
-            else
+            } else
                 cca.ev <- getEV(tmp, isDB)
             if (isPartial || first) {
                 tmp <- qr.resid(Q, Y)