From a3ab352feef0d82b3e589e9ad3366b71bf50e6c0 Mon Sep 17 00:00:00 2001 From: Thomas Guillerme Date: Fri, 17 Nov 2023 13:06:27 +0000 Subject: [PATCH] roundness metric added --- NAMESPACE | 1 + NEWS.md | 31 +++++++++--------------- R/dispRity.metric.R | 34 ++++++++++++++++++++++++++- man/dispRity.metric.Rd | 11 +++++++++ tests/testthat/test-dispRity.metric.R | 15 +++++++++--- 5 files changed, 68 insertions(+), 24 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8c084430..0e82b17e 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ export(projections.tree) export(quantiles) export(radius) export(ranges) +export(roundness) export(span.tree.length) export(variances) diff --git a/NEWS.md b/NEWS.md index 22e2ea8a..edaa00ce 100755 --- a/NEWS.md +++ b/NEWS.md @@ -3,37 +3,26 @@ dispRity v1.7.16 (2023-11-17) *dispRity.multi* - @@ -45,6 +34,7 @@ roundness <- function(matrix) { * *New* statistical test: `pgls.dispRity` to run PGLS test on a `dispRity` object with a level-2 metric and a tree (using excellent [`phylolm`](https://cran.r-project.org/web/packages/phylolm/phylolm.pdf) algorithm). The new test comes with its own S3 print, summary and plot functions if the input `dispRity` data contains multiple trees or multiple matrices (running and handling the output of multiple `phylolm`). * *New* options to `get.tree` utility function to get the trees in each subsets (thanks to Jack Hadfield for this suggestion). * *New vignette* compiling resources for developers to help people (and future me) to edit the package. + * *New metric*: `roundness` to measure the roundness of a variance-covariance matrix. ### MINOR IMPROVEMENTS @@ -67,6 +57,7 @@ roundness <- function(matrix) { * Improved automatic centering and scaling for `covar.plot` making the figures more aesthetic. * `remove.zero.brlen` now also removes negative branch lengths and works on `"multiPhylo"` objects (thanks to Thomas Johnson for this suggestion). * `fill.dispRity` has now an extra argument `check` to toggle the data checking on and off (more for developers). + * `multi.ace` is now described in details in the manual. ### BUG FIXES diff --git a/R/dispRity.metric.R b/R/dispRity.metric.R index b2d2c445..394cd718 100755 --- a/R/dispRity.metric.R +++ b/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 +#' @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 #' @title Disparity metrics #' #' @description Different implemented disparity metrics. @@ -46,6 +46,8 @@ #' \item \code{mode.val}: calculates the modal value of a vector. #' #' \item \code{n.ball.volume}: calculate the volume of the minimum n-ball (if \code{sphere = TRUE}) or of the ellipsoid (if \code{sphere = FALSE}). +#' +#' \item \code{roundness}: calculate the roundness of an elliptical representation of a variance-covariance matrix as the integral of the ranked distribution of the major axes. A value of 1 indicates a sphere, a value between 1 and 0.5 indicates a more pancake like representation and a value between 0.5 and 0 a more cigar like representation. You can force the variance-covariance calculation by using the option \code{vcv = TRUE} (default) that will calculate the variance-covariance matrix if the input is not one. #' #' } #' @@ -338,6 +340,14 @@ #' ## ranges of each column in the matrix corrected using the kth root #' ranges(dummy_matrix, k.root = TRUE) #' +#' ## roundness +#' ## calculating the variance-covariance of the dummy_matrix +#' vcv <- var(dummy_matrix) +#' ## calculating the roundness of it +#' roundness(vcv) +#' ## calculating the roundness of the dummy matrix by calculating the vcv +#' roundness(dummy_matrix, vcv = TRUE) +#' #' ## span.tree.length #' ## Minimum spanning tree length (default) #' span.tree.length(dummy_matrix) @@ -393,6 +403,7 @@ dimension.level1.fun <- function(matrix, ...) { cat("\n?group.dist") cat("\n?mode.val") cat("\n?n.ball.volume") + cat("\n?roundness") } between.groups.fun <- function(matrix, matrix2, ...) { @@ -1113,3 +1124,24 @@ projections.tree <- function(matrix, tree, type = c("root","ancestor"), referenc } } + +## The roundness function +roundness <- function(matrix, vcv = TRUE) { + ## Check the vcv + if(vcv) { + ## Check the dimensions and the triangles + if(length(unique(dim(matrix))) == 1 && all(matrix[upper.tri(matrix)] == matrix[rev(lower.tri(matrix))], na.rm = TRUE)) { + vcv <- matrix + } else { + vcv <- var(matrix) + } + } + + ## Sort and scale the eigen values + y <- sort(diag(matrix)) + y <- y/max(y) + x <- seq(from = 0, to = 1, length.out = length(y)) + ## Measure the integral + return(sum(diff(x)*zoo::rollmean(y, 2))) +} + diff --git a/man/dispRity.metric.Rd b/man/dispRity.metric.Rd index 6ad87475..9b8f678c 100755 --- a/man/dispRity.metric.Rd +++ b/man/dispRity.metric.Rd @@ -33,6 +33,7 @@ \alias{projections.tree} \alias{projections.between} \alias{disalignment} +\alias{roundness} \title{Disparity metrics} \usage{ dimension.level3.fun(matrix, ...) @@ -84,6 +85,8 @@ The currently implemented dimension-level 1 metrics are: \item \code{n.ball.volume}: calculate the volume of the minimum n-ball (if \code{sphere = TRUE}) or of the ellipsoid (if \code{sphere = FALSE}). + \item \code{roundness}: calculate the roundness of an elliptical representation of a variance-covariance matrix as the integral of the ranked distribution of the major axes. A value of 1 indicates a sphere, a value between 1 and 0.5 indicates a more pancake like representation and a value between 0.5 and 0 a more cigar like representation. You can force the variance-covariance calculation by using the option \code{vcv = TRUE} (default) that will calculate the variance-covariance matrix if the input is not one. + } See also \code{\link[base]{mean}}, \code{\link[stats]{median}}, \code{\link[base]{sum}} or \code{\link[base]{prod}} for commonly used summary metrics. @@ -361,6 +364,14 @@ ranges(dummy_matrix) ## ranges of each column in the matrix corrected using the kth root ranges(dummy_matrix, k.root = TRUE) +## roundness +## calculating the variance-covariance of the dummy_matrix +vcv <- var(dummy_matrix) +## calculating the roundness of it +roundness(vcv) +## calculating the roundness of the dummy matrix by calculating the vcv +roundness(dummy_matrix, vcv = TRUE) + ## span.tree.length ## Minimum spanning tree length (default) span.tree.length(dummy_matrix) diff --git a/tests/testthat/test-dispRity.metric.R b/tests/testthat/test-dispRity.metric.R index 3e994437..79d59dd3 100755 --- a/tests/testthat/test-dispRity.metric.R +++ b/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") + 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(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") }) @@ -350,7 +350,7 @@ test_that("ancestral.dist", { test <- dispRity(matrix, metric = ancestral.dist, tree = tree) expect_equal(c(test$disparity[[1]][[1]]), unname(ancestral.dist(matrix, tree))) - ## Works with time slices! + ## Works with time slices! data(BeckLee_mat99) data(BeckLee_tree) data <- chrono.subsets(BeckLee_mat99, BeckLee_tree, method = "continuous", model = "acctran", time = 5) @@ -951,4 +951,13 @@ if(!nocov) { #expect_equal_round(unname(unlist(disparity)), c(2.8460391, 1.5703472, 1.2262642, 0.3840770, 0.2397510, 0.7011024), 2) expect_equal_round(unname(unlist(lapply(disparity, median))), c(0.06060223, 0.02611046, 0.06848407), 5) } -}) \ No newline at end of file +}) + +test_that("roudness works", { + set.seed(1) + dummy_matrix <- matrix(rnorm(50), 5, 10) + test <- roundness(dummy_matrix, vcv = TRUE) + expect_equal_round(test, 0.1776007) + test <- roundness(var(dummy_matrix), vcv = FALSE) + expect_equal_round(test, 0.1776007) +})