From 688d10b48a1063afd10b6242b2a7851baae35376 Mon Sep 17 00:00:00 2001 From: Thomas Guillerme Date: Mon, 15 Jan 2024 13:03:07 +0000 Subject: [PATCH] added logicals to custom.subsets --- DESCRIPTION | 4 ++-- NEWS.md | 6 +++++- R/custom.subsets.R | 4 ++-- R/custom.subsets_fun.R | 10 ++++++++-- man/custom.subsets.Rd | 2 +- tests/testthat/test-as.covar.R | 1 + tests/testthat/test-custom.subsets.R | 12 ++++++++++++ 7 files changed, 31 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 32db3815..69e7a390 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,8 +7,8 @@ Authors@R: c(person("Thomas", "Guillerme", role = c("aut", "cre", "cph"), person("Jack", "Hatfield", role = c("aut", "cph")) ) Maintainer: Thomas Guillerme -Version: 1.8.1 -Date: 2023-12-15 +Version: 1.8.2 +Date: 2024-01-15 Description: A modular package for measuring disparity (multidimensional space occupancy). Disparity can be calculated from any matrix defining a multidimensional space. The package provides a set of implemented metrics to measure properties of the space and allows users to provide and test their own metrics. The package also provides functions for looking at disparity in a serial way (e.g. disparity through time) or per groups as well as visualising the results. Finally, this package provides several statistical tests for disparity analysis. Depends: R (>= 3.6.0), diff --git a/NEWS.md b/NEWS.md index d138490b..109cd149 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,10 @@ -dispRity v1.8.1 (2023-12-15) +dispRity v1.8.2 (2024-01-15) ========================= +### MINOR IMPROVEMENTS + + * `custom.subsets` can now take a logical vector for + ### BUG FIXES * `scale.dispRity` now correctly ignores `NA`s when scaling. diff --git a/R/custom.subsets.R b/R/custom.subsets.R index 9f2aaef4..044284bb 100755 --- a/R/custom.subsets.R +++ b/R/custom.subsets.R @@ -4,7 +4,7 @@ #' @description Splits the data into a customized subsets list. #' #' @param data A \code{matrix} or a \code{list} of matrices. -#' @param group Either a \code{list} of row numbers or names to be used as different groups, a \code{data.frame} with the same \eqn{k} elements as in \code{data} as rownames or a \code{factor} vector. If \code{group} is a \code{phylo} object matching \code{data}, groups are automatically generated as clades (and the tree is attached to the resulting \code{dispRity} object). +#' @param group Either a \code{list} of row numbers or names to be used as different groups, a \code{data.frame} with the same \eqn{k} elements as in \code{data} as rownames, a \code{factor} or a \code{logical} vector. If \code{group} is a \code{phylo} object matching \code{data}, groups are automatically generated as clades (and the tree is attached to the resulting \code{dispRity} object). #' @param tree \code{NULL} (default) or an optional \code{phylo} or \code{multiPhylo} object to be attached to the data. #' #' @details @@ -93,7 +93,7 @@ custom.subsets <- function(data, group, tree = NULL) { } ## Sanitize the group variable - group_class <- check.class(group, c("matrix", "data.frame", "list", "phylo", "factor")) + group_class <- check.class(group, c("matrix", "data.frame", "list", "phylo", "factor", "logical")) if(group_class == "phylo") { ## Saving the tree for export tree <- group diff --git a/R/custom.subsets_fun.R b/R/custom.subsets_fun.R index 2b984109..2b7def84 100755 --- a/R/custom.subsets_fun.R +++ b/R/custom.subsets_fun.R @@ -45,6 +45,12 @@ set.group.list <- function(group, data, group_class) { group <- as.data.frame(group) } + ## Logical is set to factor + if(group_class[1] == "logical") { + group <- as.factor(group) + group_class[1] <- "factor" + } + ## Switch methods return(switch(group_class, ## Group is already a list @@ -56,9 +62,9 @@ set.group.list <- function(group, data, group_class) { unlist(group_list, recursive = FALSE)}, ## Group is a phylo "phylo" = get.tree.clades(group, data), + ## Group is factor "factor" = {group_list <- lapply(as.list(levels(group)), function(lvl, group) which(group == lvl), group = group) ; names(group_list) <- levels(group) ; group_list} - ) - ) + )) } diff --git a/man/custom.subsets.Rd b/man/custom.subsets.Rd index 7a14e6a4..0d231b4d 100755 --- a/man/custom.subsets.Rd +++ b/man/custom.subsets.Rd @@ -12,7 +12,7 @@ custom.subsets(data, group, tree = NULL) \arguments{ \item{data}{A \code{matrix} or a \code{list} of matrices.} -\item{group}{Either a \code{list} of row numbers or names to be used as different groups, a \code{data.frame} with the same \eqn{k} elements as in \code{data} as rownames or a \code{factor} vector. If \code{group} is a \code{phylo} object matching \code{data}, groups are automatically generated as clades (and the tree is attached to the resulting \code{dispRity} object).} +\item{group}{Either a \code{list} of row numbers or names to be used as different groups, a \code{data.frame} with the same \eqn{k} elements as in \code{data} as rownames, a \code{factor} or a \code{logical} vector. If \code{group} is a \code{phylo} object matching \code{data}, groups are automatically generated as clades (and the tree is attached to the resulting \code{dispRity} object).} \item{tree}{\code{NULL} (default) or an optional \code{phylo} or \code{multiPhylo} object to be attached to the data.} } diff --git a/tests/testthat/test-as.covar.R b/tests/testthat/test-as.covar.R index e68babca..b66eb939 100755 --- a/tests/testthat/test-as.covar.R +++ b/tests/testthat/test-as.covar.R @@ -1,4 +1,5 @@ ## Test +nocov <- TRUE #package_coverage(type = "tests", quiet = FALSE, clean = FALSE) test_that("as.covar works in standalone", { diff --git a/tests/testthat/test-custom.subsets.R b/tests/testthat/test-custom.subsets.R index 54c8f88e..7b46a308 100755 --- a/tests/testthat/test-custom.subsets.R +++ b/tests/testthat/test-custom.subsets.R @@ -443,4 +443,16 @@ test_that("custom.subsets works with a factor", { expect_is(test, "dispRity") expect_equal(n.subsets(test), 3) expect_equal(size.subsets(test), c("gulls" = 159, "plovers" = 98, "sandpipers" = 102)) +}) + +test_that("custom.subsets works with a logical", { + ## Random 3D dataset with 200 taxa + data <- dispRity::space.maker(elements = 200, dimensions = 3, distribution = rnorm) + set.seed(1) + group <- sample(c(TRUE, FALSE), 200, replace = TRUE) + + ## Creating groups with a logical + expect_warning(test <- custom.subsets(data, group = group)) + expect_equal(name.subsets(test), c("FALSE", "TRUE")) + expect_equal(size.subsets(test), c("FALSE" = 98, "TRUE" = 102)) }) \ No newline at end of file