Skip to content

patching a bug related to testBetaDiversity, switching sapply to lapply #147

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
adw96 merged 2 commits into from
Jul 29, 2025
Merged

patching a bug related to testBetaDiversity, switching sapply to lapply #147

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f49ee30
patching a bug related to testBetaDiversity, switching sapply to lapply
May 1, 2025
e23b2e2
add names for group_specimens when needed
May 1, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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)
Expand Down Expand Up @@ -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
12 changes: 8 additions & 4 deletions R/s3functions.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -122,9 +122,10 @@ 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]))
names(group_specimens) <- unique_groups


if(h0 == "bray-curtis"){
Expand Down Expand Up @@ -167,9 +168,10 @@ 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]))
names(boot_group_specimens) <- unique_groups

boot_centroids[[k]] <- lapply(unique_groups,
function(gr){
Expand Down Expand Up @@ -244,9 +246,10 @@ 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]))
names(boot_group_specimens) <- unique_groups

boot_centroids[[k]] <- lapply(unique_groups,
function(gr){
Expand Down Expand Up @@ -317,9 +320,10 @@ 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]))
names(boot_group_specimens) <- unique_groups

boot_centroids[[k]] <- lapply(unique_groups,
function(gr){
Expand Down
2 changes: 1 addition & 1 deletion R/utility.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
3 changes: 3 additions & 0 deletions man/pick_base.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

21 changes: 21 additions & 0 deletions tests/testthat/test_s3.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
Loading