From 7ff1443b338e7b0204150fb598f277968540f2eb Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:10:27 +0200 Subject: [PATCH 1/8] scoping & accept dissimilarities as symmetric matrices adonis2(df ~ ., data) failed because 'df' was not sought first in the .GlobalEnv and function df() was found before data df. --- R/adonis2.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/adonis2.R b/R/adonis2.R index 4d75a6eec..f5e1a86d5 100644 --- a/R/adonis2.R +++ b/R/adonis2.R @@ -34,7 +34,7 @@ TOL <- 1e-7 Terms <- terms(formula, data = data) lhs <- formula[[2]] - lhs <- eval(lhs, data, parent.frame()) # to force evaluation + lhs <- eval(lhs, .GlobalEnv, environment(formula)) # to force evaluation formula[[2]] <- NULL # to remove the lhs rhs.frame <- model.frame(formula, data, drop.unused.levels = TRUE) # to get the data frame of rhs rhs <- model.matrix(formula, rhs.frame) # and finally the model.matrix @@ -42,6 +42,9 @@ rhs <- scale(rhs, scale = FALSE, center = TRUE) # center qrhs <- qr(rhs) ## handle dissimilarities + if ((is.matrix(lhs) || is.data.frame(lhs)) && + isSymmetric(unname(as.matrix(lhs)))) + lhs <- as.dist(lhs) if (inherits(lhs, "dist")) { if (any(lhs < -TOL)) stop("dissimilarities must be non-negative") From e0aa41a2b13f1d1684c31506dca37db77de4ea7b Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:22:00 +0200 Subject: [PATCH 2/8] add dissimilarities as symmetric matrices or data.frames --- R/dbrda.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/dbrda.R b/R/dbrda.R index 5cf3f139c..f7f563d57 100644 --- a/R/dbrda.R +++ b/R/dbrda.R @@ -19,6 +19,9 @@ ## mysteriously at this point. X <- eval(formula[[2]], envir=environment(formula), enclos = globalenv()) + if ((is.matrix(X) || is.data.frame(X)) && + isSymmetric(unname(as.matrix(X)))) + X <- as.dist(X) if (!inherits(X, "dist")) { comm <- X dfun <- match.fun(dfun) From 96bb628b9833980d4d1b7bbb8ea33c6870c43283 Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:29:55 +0200 Subject: [PATCH 3/8] clean and correct test for distances in symmetric matrices as.dist() was not done after successful test for symmetric matrices and analysis failed later when it assumed data are no dist objects. --- R/anosim.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/anosim.R b/R/anosim.R index dba93b325..6703655fe 100644 --- a/R/anosim.R +++ b/R/anosim.R @@ -5,12 +5,13 @@ EPS <- sqrt(.Machine$double.eps) if (inherits(dat, "dist")) x <- dat - else if (is.matrix(dat) && nrow(dat) == ncol(dat) && all(dat[lower.tri(dat)] == - t(dat)[lower.tri(dat)])) { - x <- dat + else if ((is.matrix(dat) || is.data.frame(dat)) && + isSymmetric(unname(as.matrix(dat)))) { + x <- as.dist(dat) attr(x, "method") <- "user supplied square matrix" } - else x <- vegdist(dat, method = distance) + else + x <- vegdist(dat, method = distance) if (any(x < -sqrt(.Machine$double.eps))) warning("some dissimilarities are negative -- is this intentional?") sol <- c(call = match.call()) From dc815de504391a344264320cecfff0dfd6cabb84 Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:35:37 +0200 Subject: [PATCH 4/8] cleaner test for distances in symmetric matrices or data frames earlier failed with data.frames --- R/bioenv.default.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/bioenv.default.R b/R/bioenv.default.R index f7dc3f961..e821b4ee1 100644 --- a/R/bioenv.default.R +++ b/R/bioenv.default.R @@ -70,8 +70,8 @@ function (comm, env, method = "spearman", index = "bray", upto = ncol(env), index <- attr(comdis, "method") if (is.null(index)) index <- "unspecified" - } else if (is.matrix(comm) && nrow(comm) == ncol(comm) && - isTRUE(all.equal(comm, t(comm)))) { + } else if ((is.matrix(comm) || is.data.frame(comm)) && + isSymmetric(unname(as.matrix(comm)))) { comdis <- as.dist(comm) index <- "supplied square matrix" } else { From f580f8d7feb7509244d9e1ddb65e245ffb4a1560 Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:43:59 +0200 Subject: [PATCH 5/8] more robust test for distances in symmetric squares --- R/metaMDS.R | 4 ++-- R/metaMDSdist.R | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/metaMDS.R b/R/metaMDS.R index db82a8102..353d85c88 100644 --- a/R/metaMDS.R +++ b/R/metaMDS.R @@ -27,8 +27,8 @@ if (is.null(attr(dis, "method"))) attr(dis, "method") <- "user supplied" wascores <- FALSE - } else if (length(dim(comm) == 2) && ncol(comm) == nrow(comm) && - all(comm == t(comm))) { + } else if ((is.matrix(comm) || is.data.frame(comm)) && + isSymmetric(unname(as.matrix(comm)))) { dis <- as.dist(comm) attr(dis, "method") <- "user supplied" wascores <- FALSE diff --git a/R/metaMDSdist.R b/R/metaMDSdist.R index 8b9164830..31f20ece0 100644 --- a/R/metaMDSdist.R +++ b/R/metaMDSdist.R @@ -5,8 +5,9 @@ { ## metaMDSdist should get a raw data matrix, but if it gets a ## 'dist' object return that unchanged and quit silently. - if (inherits(comm, "dist") || ncol(comm) == nrow(comm) && - all(comm == t(comm))) + if (inherits(comm, "dist") || + ((is.matrix(comm) || is.data.frame(comm)) && + isSymmetric(unname(as.matrix(comm))))) return(comm) distname <- deparse(substitute(distfun)) distfun <- match.fun(distfun) From ac5df2f7f011ddcb45d668a18eedac8831dd9ef4 Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:50:21 +0200 Subject: [PATCH 6/8] cleaner test for distances in symmetric matrices or data frames --- R/monoMDS.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/monoMDS.R b/R/monoMDS.R index a3a5fd55d..a5bf8f1cb 100644 --- a/R/monoMDS.R +++ b/R/monoMDS.R @@ -6,9 +6,9 @@ sratmax=0.99999, ...) { ## Check that 'dist' are distances or a symmetric square matrix - if (!(inherits(dist, "dist") || (is.matrix(dist) || is.data.frame(dist)) - && ncol(dist) == nrow(dist) - && isTRUE(all.equal(dist[lower.tri(dist)], t(dist)[lower.tri(dist)])))) + if (!(inherits(dist, "dist") || + ((is.matrix(dist) || is.data.frame(dist)) && + isSymmetric(unname(as.matrix(dist)))))) stop("'dist' must be a distance object (class \"dist\") or a symmetric square matrix") if (any(dist < -sqrt(.Machine$double.eps), na.rm = TRUE)) warning("some dissimilarities are negative -- is this intentional?") From c10762873165c108e9591b1f0e38fbd5af13a87c Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Thu, 19 Nov 2015 19:54:39 +0200 Subject: [PATCH 7/8] cleaner test for symmetric matrices that also works for data frames --- R/mrpp.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mrpp.R b/R/mrpp.R index cf28454b1..bf7e8d237 100644 --- a/R/mrpp.R +++ b/R/mrpp.R @@ -14,8 +14,8 @@ } if (inherits(dat, "dist")) dmat <- dat - else if (is.matrix(dat) && nrow(dat) == ncol(dat) && all(dat[lower.tri(dat)] == - t(dat)[lower.tri(dat)])) { + else if ((is.matrix(dat) || is.data.frame(dat)) && + isSymmetric(unname(as.matrix(dat)))) { dmat <- dat attr(dmat, "method") <- "user supplied square matrix" } From d5c0f194454bf1adf3f2296cd90f3d1aff497307 Mon Sep 17 00:00:00 2001 From: Jari Oksanen Date: Fri, 20 Nov 2015 09:57:57 +0200 Subject: [PATCH 8/8] more canonical testing for distances in symmetric matrix --- R/pcnm.R | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/R/pcnm.R b/R/pcnm.R index 229bce46a..99a6760a9 100644 --- a/R/pcnm.R +++ b/R/pcnm.R @@ -1,15 +1,11 @@ `pcnm` <- function(dis, threshold, w, dist.ret = FALSE) { - if (!inherits(dis, "dist")) { - dims <- dim(dis) - if (length(unique(dims)) >1) { - stop("'dis' does not appear to be a square distance matrix.") - } + ## square matrix to dist + if ((is.matrix(dis) || is.data.frame(dis)) && + isSymmetric(unname(as.matrix(dis)))) dis <- as.dist(dis) - } + if (!inherits(dis, "dist")) + stop("'dis' does not appear to be distances") EPS <- sqrt(.Machine$double.eps) - wa.old <- options(warn = -1) - on.exit(options(wa.old)) - dis <- as.dist(dis) if (missing(threshold)) { threshold <- max(spantree(dis)$dist) }