removed S3 methods bugs for DEB and WIN

NAMESPACE

@@ -63,7 +63,8 @@ export(dimension.level2.fun)
 export(dimension.level3.fun)
 export(disalignment)
 export(displacements)
-export(ellipse.volume)
+export(ellipse.volume) # alias for ellipsoid.volume
+export(ellipsoid.volume)
 export(edge.length.tree)
 export(func.div)
 export(func.eve)
@@ -108,7 +109,8 @@ export(get.covar)
 export(n.subsets)
 export(make.dispRity)
 export(name.subsets)
-export(rescale.dispRity)
+export(rescale.dispRity) # alias for scale
+export(scale.dispRity)
 export(size.subsets)
 export(sort.dispRity)
 export(add.tree)
@@ -146,7 +148,8 @@ export(get.contrast.matrix)
 export(sim.morpho)
 export(multi.ace)
 
-##S3 
+##S3
+S3method(scale, dispRity)
 S3method(matrix, dispRity)
 S3method(plot, char.diff)
 S3method(plot, dispRity)

NEWS.md

@@ -42,6 +42,12 @@ dispRity v1.8 (2023-12-06) *dispRity.multi*
  * `make.metric` now internally handles `covar` object correctly (i.e. as distance matrices).
  * Calculating disparity for multiple matrices and customised subsets now works as expected for all metric levels.
 
+### DEPRECATED AND DEFUNCT
+
+ * `ellipse.volume` has been changed to `ellipsoid.volume` to more accurately reflect what it is measuring.
+ * `rescale.dispRity` has been changed to `scale.dispRity` and correctly registered as a S3 method.
+
+
 dispRity v1.7 (2022-08-08) *MacMacGlimm*
 =========================
 

R/dispRity.metric.R

@@ -1,5 +1,5 @@
 #' @name dispRity.metric
-#' @aliases dimension.level3.fun dimension.level2.fun dimension.level1.fun between.groups.fun variances ranges centroids mode.val ellipse.volume edge.length.tree convhull.surface convhull.volume diagonal ancestral.dist pairwise.dist span.tree.length n.ball.volume radius neighbours displacements quantiles func.eve func.div angles deviations group.dist point.dist projections projections.tree projections.between disalignment roundness
+#' @aliases dimension.level3.fun dimension.level2.fun dimension.level1.fun between.groups.fun variances ranges centroids mode.val ellipsoid.volume edge.length.tree convhull.surface convhull.volume diagonal ancestral.dist pairwise.dist span.tree.length n.ball.volume radius neighbours displacements quantiles func.eve func.div angles deviations group.dist point.dist projections projections.tree projections.between disalignment roundness
 #' @title Disparity metrics
 #'
 #' @description Different implemented disparity metrics.
@@ -31,7 +31,7 @@
 #'          \item WARNING: This function is the generalisation of Pythagoras' theorem and thus \bold{works only if each dimensions are orthogonal to each other}.
 #'      }
 #'
-#'   \item \code{ellipse.volume}: calculates the ellipsoid volume of a matrix. This function tries to determine the nature of the input matrix and uses one of these following methods to calculate the volume. You can always specify the method using \code{method = "my_choice"} to overrun the automatic method choice.
+#'   \item \code{ellipsoid.volume}: calculates the ellipsoid volume of a matrix. This function tries to determine the nature of the input matrix and uses one of these following methods to calculate the volume. You can always specify the method using \code{method = "my_choice"} to overrun the automatic method choice.
 #'      \itemize{
 #'             \item \code{"eigen"}: this method directly calculates the eigen values from the input matrix (using \code{\link{eigen}}). This method is automatically selected if the input matrix is "distance like" (i.e. square with two mirrored triangles and a diagonal).
 #'             \item \code{"pca"}: this method calculates the eigen values as the sum of the variances of the matrix (\code{abs(apply(var(matrix),2, sum))}). This is automatically selected if the input matrix is NOT "distance like". Note that this method is faster than \code{"eigen"} but only works if the input matrix is an ordinated matrix from a PCA, PCO, PCoA, NMDS or MDS.
@@ -218,13 +218,13 @@
 #' ## The edge lengths for each edge leading to the elements in the matrix
 #' edge.length.tree(named_matrix, tree = dummy_tree, to.root = FALSE)
 #' 
-#' ## ellipse.volume
+#' ## ellipsoid.volume
 #' ## Ellipsoid volume of a matrix
-#' ellipse.volume(dummy_matrix)
+#' ellipsoid.volume(dummy_matrix)
 #' ## Calculating the same volume with provided eigen values
 #' ordination <- prcomp(dummy_matrix)
 #' ## Calculating the ellipsoid volume by providing your own eigen values
-#' ellipse.volume(ordination$x, method = ordination$sdev^2)
+#' ellipsoid.volume(ordination$x, method = ordination$sdev^2)
 #' 
 #' ## func.div
 #' ## Functional divergence
@@ -397,7 +397,7 @@ dimension.level1.fun <- function(matrix, ...) {
     cat("\n?convhull.surface")
     cat("\n?convhull.volume")
     cat("\n?diagonal")
-    cat("\n?ellipse.volume")
+    cat("\n?ellipsoid.volume")
     cat("\n?func.div")
     cat("\n?func.eve")
     cat("\n?group.dist")
@@ -515,7 +515,7 @@ mode.val <- function(matrix, ...){
 }
 
 ## Calculate the ellipse volume of matrix
-ellipse.volume <- function(matrix, method, ...) {
+ellipsoid.volume <- function(matrix, method, ...) {
 
     ## Initialising the variables
     ncol_matrix <- ncol(matrix)
@@ -550,6 +550,10 @@ ellipse.volume <- function(matrix, method, ...) {
     ## Volume (from https://keisan.casio.com/exec/system/1223381019)
     return(pi^(ncol_matrix/2)/gamma((ncol_matrix/2)+1)*prod(semi_axes))
 }
+## Alias
+ellipse.volume <- function(x, ...) {
+    ellipsoid.volume(matrix = x, ...)
+}
 
 ## Calculate the convex hull hypersurface
 convhull.surface <- function(matrix, ...) {

R/dispRity.utilities.R

@@ -630,7 +630,7 @@ remove.tree <- function(data) {
 #'
 #' @description Scales or/and centers the disparity measurements.
 #'
-#' @param data a \code{dispRity} object.
+#' @param x a \code{dispRity} object.
 #' @param center either a \code{logical} value or a \code{numeric} vector of length equal to the number of elements of \code{data} (default is \code{FALSE}).
 #' @param scale either a \code{logical} value or a \code{numeric} vector of length equal to the number of elements of \code{data} (default is \code{TRUE}).
 #' @param use.all \code{logical}, whether to scale/center using the full distribution (i.e. all the disparity values) or only the distribution within each subsets of bootstraps (default is \code{TRUE}).
@@ -641,9 +641,9 @@ remove.tree <- function(data) {
 #' data(disparity)
 #' 
 #' ## Scaling the data
-#' summary(rescale.dispRity(disparity, scale = TRUE)) # Dividing by the maximum
+#' summary(scale.dispRity(disparity, scale = TRUE)) # Dividing by the maximum
 #' ## Multiplying by 10 (dividing by 0.1)
-#' summary(rescale.dispRity(disparity, scale = 0.1))
+#' summary(scale.dispRity(disparity, scale = 0.1))
 #'
 #' @seealso \code{\link{dispRity}}, \code{\link{test.dispRity}}, \code{\link[base]{scale}}.
 #'
@@ -659,11 +659,12 @@ remove.tree <- function(data) {
 # data <- dispRity(bootstrapped_data, metric = c(sum, centroids))
 
 # summary(data) # No scaling
-# summary(rescale.dispRity(data, scale = TRUE)) # Dividing by the maximum
-# summary(rescale.dispRity(data, scale = 0.1)) # Multiplying by 10
-# summary(rescale.dispRity(data, center = TRUE, scale = TRUE)) # Scaling and centering
-rescale.dispRity <- function(data, center = FALSE, scale = TRUE, use.all = TRUE, ...) {
+# summary(scale.dispRity(data, scale = TRUE)) # Dividing by the maximum
+# summary(scale.dispRity(data, scale = 0.1)) # Multiplying by 10
+# summary(scale.dispRity(data, center = TRUE, scale = TRUE)) # Scaling and centering
+scale.dispRity <- function(x, center = FALSE, scale = TRUE, use.all = TRUE, ...) {
 
+    data <- x
     match_call <- match.call()
 
     ## data
@@ -705,7 +706,9 @@ rescale.dispRity <- function(data, center = FALSE, scale = TRUE, use.all = TRUE,
 
     return(data)
 }
-
+rescale.dispRity <- function(x, ...) {
+    scale.dispRity(x, ...)
+}
 
 
 

R/null.test.R

@@ -18,7 +18,7 @@
 #' ## Load the Beck & Lee 2014 data
 #' data(BeckLee_mat50)
 #' ## Calculating the disparity as the ellipsoid volume
-#' obs_disparity <- dispRity(BeckLee_mat50, metric = ellipse.volume)
+#' obs_disparity <- dispRity(BeckLee_mat50, metric = ellipsoid.volume)
 #' ## Testing against normal distribution
 #' results <- null.test(obs_disparity, replicates = 100, null.distrib = rnorm)
 #' results ; plot(results)

R/randtest.dispRity.R

@@ -2,7 +2,7 @@
 #'
 #' @description Performs a random test (aka permutation test) on a \code{matrix} or a \code{dispRity} object.
 #'
-#' @param data The \code{matrix} or a \code{dispRity} object to draw from.
+#' @param xtest The \code{matrix} or a \code{dispRity} object to draw from.
 #' @param subsets A \code{vector} of elements to test (or a \code{list} of \code{vectors} - see details).
 #' @param replicates A \code{numeric} value for the number of replicates (\code{default = 100}).
 #' @param metric A \code{function} to be the statistic to apply to the subset.
@@ -65,9 +65,12 @@
 #' @author Thomas Guillerme
 #' @export
 
-randtest.dispRity <- function(data, subsets, metric, replicates = 100, resample = TRUE, alter = "two-sided", ...) {
+randtest.dispRity <- function(xtest, subsets, metric, replicates = 100, resample = TRUE, alter = "two-sided", ...) {
     match_call <- match.call()
     args <- list(...)
+    data <- xtest
+    names(match_call)[which(names(match_call) == "xtest")] <- "data"
+
 
     ## Sanitizing
     ## Distribution and subset

R/randtest.dist.R

@@ -2,7 +2,7 @@
 #'
 #' @description Measures the distance between the observed statistic from a \code{"randtest"} object and some specific quantile of the simulated data.
 #'
-#' @param randtest an object of class \code{"randtest"}
+#' @param xtest an object of class \code{"randtest"}
 #' @param quantile a \code{numeric} value for the quantile edges to compare the observed data to on either sides (by default \code{quantile = c(0.025. 0.975)}).
 #' @param abs \code{logical}, whether to calculate the distance as an absolute value (\code{TRUE}) or not (\code{FALSE} - default).
 #' 
@@ -32,7 +32,9 @@
 #' @author Thomas Guillerme
 #' @export
 
-randtest.dist <- function(randtest, quantile = c(0.025, 0.975), abs = FALSE) {
+randtest.dist <- function(xtest, quantile = c(0.025, 0.975), abs = FALSE) {
+
+    randtest <- xtest
 
     ## Checking randtest
     check.class(randtest, "randtest")

tests/testthat/test-as.covar.R

@@ -45,7 +45,7 @@ test_that("as.covar works in standalone", {
     if(!nocov) expect_true(eval.covar(test$level1.fun, null.return = FALSE))
 
     ## level 1 covar (with formals)
-    metric <- as.covar(ellipse.volume)
+    metric <- as.covar(ellipsoid.volume)
     if(!nocov) expect_true(check.covar(metric, covar_data)$is_covar)
     test <- get.dispRity.metric.handle(metric, match_call, data = covar_data, tree = NULL)$levels
     expect_true(is.null(test$level3.fun))

tests/testthat/test-dispRity.metric.R

@@ -7,7 +7,7 @@ nocov <- TRUE
 test_that("dimension generic", {
     expect_equal(capture_output(dimension.level3.fun()), "No implemented Dimension level 3 functions implemented in dispRity!\nYou can create your own by using: ?make.metric")
     expect_equal(capture_output(dimension.level2.fun()), "Dimension level 2 functions implemented in dispRity:\n?ancestral.dist\n?angles\n?centroids\n?deviations\n?displacements\n?edge.length.tree\n?neighbours\n?pairwise.dist\n?point.dist\n?projections\n?projections.tree\n?ranges\n?radius\n?variances\n?span.tree.length")
-    expect_equal(capture_output(dimension.level1.fun()), "Dimension level 1 functions implemented in dispRity:\n?convhull.surface\n?convhull.volume\n?diagonal\n?ellipse.volume\n?func.div\n?func.eve\n?group.dist\n?mode.val\n?n.ball.volume\n?roundness")
+    expect_equal(capture_output(dimension.level1.fun()), "Dimension level 1 functions implemented in dispRity:\n?convhull.surface\n?convhull.volume\n?diagonal\n?ellipsoid.volume\n?func.div\n?func.eve\n?group.dist\n?mode.val\n?n.ball.volume\n?roundness")
     expect_equal(capture_output(between.groups.fun()), "Between groups functions implemented in dispRity:\n?disalignment # level 1\n?group.dist # level 1\n?point.dist # level 2\n?projections.between # level 2")
 })
 
@@ -130,7 +130,7 @@ test_that("mode.val metric", {
     	)
 })
 
-test_that("ellipse.volume metric", {
+test_that("ellipsoid.volume metric", {
     # Calculate the proper volume (using the eigen values)
     volume.true <- function(matrix, eigen.val) {
         #Correct calculation of the volume (using the eigen values)
@@ -156,14 +156,14 @@ test_that("ellipse.volume metric", {
     # Calculate the true volume (with eigen values)
     true_vol <- volume.true(dummy_ord, dummy_eig/(nrow(dummy_dis)-1))
     # Calculate the volume without the eigen values
-    test_vol <- ellipse.volume(dummy_ord)
+    test_vol <- ellipsoid.volume(dummy_ord)
     # test
     expect_equal(
     	true_vol, test_vol
     	)
     # test with the eigen val estimation
     expect_equal(
-        true_vol, ellipse.volume(dummy_ord, eigen.value = dummy_eig/(nrow(dummy_dis)-1))
+        true_vol, ellipsoid.volume(dummy_ord, eigen.value = dummy_eig/(nrow(dummy_dis)-1))
         )
 
     # Now testing for PCOA
@@ -173,14 +173,14 @@ test_that("ellipse.volume metric", {
     # Calculate the true volume (with eigen values)
     true_vol <- volume.true(dummy_ord, dummy_eig/(nrow(dummy_dis)-1))
     # Calculate the volume without the eigen values
-    test_vol <- ellipse.volume(dummy_ord)
+    test_vol <- ellipsoid.volume(dummy_ord)
     # test
     expect_equal(
     	true_vol, test_vol
     	)
     # test with the eigen val estimation
     expect_equal(
-        true_vol, ellipse.volume(dummy_ord, eigen.value = dummy_eig/(nrow(dummy_dis)-1))
+        true_vol, ellipsoid.volume(dummy_ord, eigen.value = dummy_eig/(nrow(dummy_dis)-1))
         )