From f49ee301891b81ecdd3a291fdb5d3da15701d5e0 Mon Sep 17 00:00:00 2001 From: Sarah Teichman Date: Thu, 1 May 2025 11:14:54 -0700 Subject: [PATCH 1/2] patching a bug related to testBetaDiversity, switching sapply to lapply --- DESCRIPTION | 4 ++-- R/s3functions.R | 8 ++++---- R/utility.R | 2 +- man/pick_base.Rd | 3 +++ tests/testthat/test_s3.R | 21 +++++++++++++++++++++ 5 files changed, 31 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1180aeb..39daa79 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: DivNet Type: Package Title: Diversity Estimation in Networked Ecological Communities -Version: 0.4.0 +Version: 0.4.1 Authors@R: c(person("Amy", "Willis", email = "adwillis@uw.edu", role = c("aut", "cre")), person("Bryan D", "Martin", email = "bmartin6@uw.edu", role = c("aut"))) Description: Estimate alpha- and beta- diversity of a community where taxa interact. License: GPL (>= 2) @@ -39,5 +39,5 @@ Suggests: Additional_repositories: https://github.com/mikemc/speedyseq Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.2 +RoxygenNote: 7.3.2 VignetteBuilder: knitr diff --git a/R/s3functions.R b/R/s3functions.R index 5ba509d..6267dda 100644 --- a/R/s3functions.R +++ b/R/s3functions.R @@ -122,7 +122,7 @@ testBetaDiversity <- function(dv, unique_groups <- unique(groups) unique_specimens <- colnames(sample_specimen_matrix) n_specimens <- ncol(sample_specimen_matrix) - group_specimens <- sapply(unique_groups, + group_specimens <- lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,],2,max) %>% (function(y) names(y)[y==1])) @@ -167,7 +167,7 @@ if(h0 == "bray-curtis"){ comps <- dv$fitted_z[which_samples,] - boot_group_specimens <-sapply(unique_groups, + boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) @@ -244,7 +244,7 @@ if(h0 == "euclidean"){ comps <- dv$fitted_z[which_samples,] - boot_group_specimens <-sapply(unique_groups, + boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) @@ -317,7 +317,7 @@ if(h0 == "aitchison"){ comps <- log_ratio(dv$fitted_z[which_samples,]) - boot_group_specimens <-sapply(unique_groups, + boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) diff --git a/R/utility.R b/R/utility.R index 852ad30..796be3d 100644 --- a/R/utility.R +++ b/R/utility.R @@ -51,7 +51,7 @@ acomb3 <- function(...) abind(..., along = 3) #' @param automatic_cutoff Choose detection cutoff automatically? Default is #' FALSE. If TRUE, detection_cutoff will be set equal to the maximum proportion #' of samples any taxon is detected in. -#' @value Index corresponding to taxon chosen as base taxon +#' @return Index corresponding to taxon chosen as base taxon #' @author Amy Willis #' @export pick_base <- function(W, diff --git a/man/pick_base.Rd b/man/pick_base.Rd index c780238..15a6aaf 100644 --- a/man/pick_base.Rd +++ b/man/pick_base.Rd @@ -17,6 +17,9 @@ unless automatic_cutoff is set to TRUE.} FALSE. If TRUE, detection_cutoff will be set equal to the maximum proportion of samples any taxon is detected in.} } +\value{ +Index corresponding to taxon chosen as base taxon +} \description{ Picks the base taxon to be used in divnet fit. If no taxon is detected in all samples, returns error; in this case, we recommend manually choosing diff --git a/tests/testthat/test_s3.R b/tests/testthat/test_s3.R index 08b357c..2e97c19 100644 --- a/tests/testthat/test_s3.R +++ b/tests/testthat/test_s3.R @@ -36,6 +36,27 @@ test_that("beta diversity hypothesis testing works for bray-curtis", { n_boot = 10), "list") }) +test_that("beta diversity hypothesis testing works with two even groups", { + Lee_even <- Lee_subset %>% + phyloseq::subset_samples(sample_id %in% c(3:4, 6:9, 15:16)) + divnet_phylum_even <- divnet(Lee_even, + X = "sample_id", tuning = "test") + ss_mat_even = diag(nrow(sample_data(Lee_even))) + colnames(ss_mat_even) <- sample_data(Lee_even)$sample_id + expect_is(testBetaDiversity(dv = divnet_phylum_even, h0 = "bray-curtis", + groups = sample_data(Lee_even)$char, + sample_specimen_matrix = ss_mat_even, + n_boot = 10), "list") + expect_is(testBetaDiversity(dv = divnet_phylum_even, h0 = "euclidean", + groups = sample_data(Lee_even)$char, + sample_specimen_matrix = ss_mat_even, + n_boot = 10), "list") + expect_is(testBetaDiversity(dv = divnet_phylum_even, h0 = "aitchison", + groups = sample_data(Lee_even)$char, + sample_specimen_matrix = ss_mat_even, + n_boot = 10), "list") +}) + test_that("beta diversity hypothesis testing works for euclidean", { expect_is(testBetaDiversity(dv = divnet_phylum_sample, h0 = "euclidean", groups = sample_data(Lee_subset)$char, From e23b2e2b402e554dd3952be584d888444b3b50dd Mon Sep 17 00:00:00 2001 From: Sarah Teichman Date: Thu, 1 May 2025 11:38:14 -0700 Subject: [PATCH 2/2] add names for group_specimens when needed --- R/s3functions.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/s3functions.R b/R/s3functions.R index 6267dda..f4059d6 100644 --- a/R/s3functions.R +++ b/R/s3functions.R @@ -125,6 +125,7 @@ testBetaDiversity <- function(dv, group_specimens <- lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,],2,max) %>% (function(y) names(y)[y==1])) + names(group_specimens) <- unique_groups if(h0 == "bray-curtis"){ @@ -170,6 +171,7 @@ if(h0 == "bray-curtis"){ boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) + names(boot_group_specimens) <- unique_groups boot_centroids[[k]] <- lapply(unique_groups, function(gr){ @@ -247,6 +249,7 @@ if(h0 == "euclidean"){ boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) + names(boot_group_specimens) <- unique_groups boot_centroids[[k]] <- lapply(unique_groups, function(gr){ @@ -320,6 +323,7 @@ if(h0 == "aitchison"){ boot_group_specimens <-lapply(unique_groups, function(x) apply(sample_specimen_matrix[groups == x,np_boot_pulls[,k]],2,max) %>% (function(y) names(y)[y==1])) + names(boot_group_specimens) <- unique_groups boot_centroids[[k]] <- lapply(unique_groups, function(gr){