tests/testthat/test-bootstrap.R
In shaelebrown/TDAML: Machine Learning and Inference for Topological Data Analysis
# test_that("bootstrap_persistence_thresholds can do homology calculation with all three packages",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# D <- TDA::circleUnif(n = 50,r = 1)
# # ripser = import_ripser()
# expect_length(bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2.1,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2.1,num_workers = 2,num_samples = 3),2)
# # expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "PyH",FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,num_workers = 2,num_samples = 3),3)
# # expect_length(bootstrap_persistence_thresholds(X = D,FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,calculate_representatives = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),maxdim = 1,thresh = 2,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = T,num_workers = 2,num_samples = 3),2)
# # expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),3)
# # expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "PyH",FUN_diag = "PyH",maxdim = 1,thresh = 2,ripser = ripser,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),3)
#
# })
# test_that("bootstrap_persistence_thresholds can detect incorrect parameters correctly",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# # X, FUN, maxdim, thresh, distance_mat, ripser, ignore_infinite_cluster, calculate_representatives, num_samples, alpha, return_subsetted, return_diag
# expect_error(bootstrap_persistence_thresholds(data.frame(),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = c(1,2),y = c("1","2")),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(X = NULL,maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(X = data.frame(x = c(1,NA)),maxdim = 1,thresh = 2),"missing")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = c(1),y = c(2)),maxdim = 1,thresh = 2),"two")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculatehomology",maxdim = 1,thresh = 2),"calculate_homology")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = NULL,maxdim = 1,thresh = 2),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = 2,maxdim = 1,thresh = 2),"string")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = "calculatehomology",maxdim = 1,thresh = 2),"calculate_homology")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = NULL,maxdim = 1,thresh = 2),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = 2,maxdim = 1,thresh = 2),"string")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1.1,thresh = 2),"whole")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = NA,thresh = 2),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = -1,thresh = 2),"negative")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = 0),"positive")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = NaN),"NaN")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = "2"),"numeric")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,distance_mat = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = NA),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = T),"square")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,p_less_than_alpha = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = NA),"NA")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_pvals = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = NA),"NA")
#
# # PyH parameters (ripser,ignore_infinite_cluster,calculate_representatives) are all working, tested in test-python.R
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = c(T,F)),"boolean")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,calculate_representatives = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,calculate_representatives = NA),"NA")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,num_samples = 0),"one")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,num_samples = Inf),"finite")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,alpha = NA),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,alpha = 2),"1")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,alpha = c(0.5,0.4)),"single")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_subsetted = c(T,F)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_subsetted = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = Inf),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = NA),"NA")
#
# })
# test_that("bootstrap_persistence_thresholds is computing properly",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# D <- TDA::circleUnif(n = 50,r = 1)
#
# # ripsDiag
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# if(length(which(bs$subsetted_diag$dimension == 0)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# }
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# if(length(which(bs$subsetted_diag$dimension == 0)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# }
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
#
# # calculate_homology
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$thresholds,2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
#
# # check on circle:
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3)
# expect_lte(length(bs$subsetted_diag$dimension),2)
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3)
# expect_lte(length(bs$subsetted_diag$dimension),1)
#
# # one example by hand to verify thresholds
# D <- data.frame(x = c(0,0,0),y = c(1,2,2.5))
# diag <- diagram_to_df(TDA::ripsDiag(D,maxdimension = 0,maxscale = 2.5,library = "dionysus"))
# permuted_diag <- function(D,s)
# {
# return(TDA::ripsDiag(X = D[s,],maxdimension = 0,maxscale = 2.5,library = "dionysus"))
# }
# d1 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,1)),dim = 0,p = Inf)
# d2 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,2)),dim = 0,p = Inf)
# d3 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,3)),dim = 0,p = Inf)
# d4 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,2)),dim = 0,p = Inf)
# d5 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,3)),dim = 0,p = Inf)
# d6 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,1)),dim = 0,p = Inf)
# d7 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,3)),dim = 0,p = Inf)
# d8 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,1)),dim = 0,p = Inf)
# d9 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,2)),dim = 0,p = Inf)
# d10 <- diagram_distance(diag,diag,dim = 0,p = Inf)
# unique_vals <- unique(c(d1,d2,d3,d4,d5,d6,d7,d8,d9,d10))
# thresholds <- c()
# for(i in 1:3)
# {
# for(j in 1:3)
# {
# for(k in 1:3)
# {
# thresholds <- c(thresholds,2*stats::quantile(unique_vals[c(i,j,k)],probs = 0.95)[[1]])
# }
# }
# }
# thresholds <- unique(thresholds)
# expect_true(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 0,thresh = 2.5,num_workers = 2,num_samples = 3)$thresholds %in% thresholds)
#
# # check p-values
# D <- TDA::circleUnif(n = 100,r = 1)
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T)
# expect_lte(length(bs$pvals),2L)
# expect_true(bs$pvals[[1]] < 0.1)
# if(length(bs$pvals) == 2L)
# {
# expect_true(bs$pvals[[2]] < 0.1)
# }
#
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,p_less_than_alpha = T,alpha = 1/31)
# expect_identical(length(bs$pvals),0L)
#
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,calculate_representatives = T,alpha = 1/31)
# expect_lte(length(bs$pvals),2L)
# expect_true(bs$pvals[[1]] < 0.1)
# if(length(bs$pvals) == 2L)
# {
# expect_true(bs$pvals[[2]] < 0.1)
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,calculate_representatives = T,alpha = 1/31,p_less_than_alpha = T)
# expect_identical(length(bs$subsetted_representatives),0L)
#
# })
shaelebrown/TDAML documentation built on Nov. 1, 2024, 8:59 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# test_that("bootstrap_persistence_thresholds can do homology calculation with all three packages",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# D <- TDA::circleUnif(n = 50,r = 1)
# # ripser = import_ripser()
# expect_length(bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2.1,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2.1,num_workers = 2,num_samples = 3),2)
# # expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "PyH",FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,num_workers = 2,num_samples = 3),3)
# # expect_length(bootstrap_persistence_thresholds(X = D,FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,calculate_representatives = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),maxdim = 1,thresh = 2,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = T,num_workers = 2,num_samples = 3),2)
# # expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "PyH",maxdim = 1,thresh = 2,ripser = ripser,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),2)
# expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),3)
# # expect_length(bootstrap_persistence_thresholds(X = as.matrix(dist(D)),FUN_boot = "PyH",FUN_diag = "PyH",maxdim = 1,thresh = 2,ripser = ripser,calculate_representatives = T,distance_mat = T,num_workers = 2,num_samples = 3),3)
#
# })
# test_that("bootstrap_persistence_thresholds can detect incorrect parameters correctly",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# # X, FUN, maxdim, thresh, distance_mat, ripser, ignore_infinite_cluster, calculate_representatives, num_samples, alpha, return_subsetted, return_diag
# expect_error(bootstrap_persistence_thresholds(data.frame(),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = c(1,2),y = c("1","2")),maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(X = NULL,maxdim = 1,thresh = 2),"X")
# expect_error(bootstrap_persistence_thresholds(X = data.frame(x = c(1,NA)),maxdim = 1,thresh = 2),"missing")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = c(1),y = c(2)),maxdim = 1,thresh = 2),"two")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculatehomology",maxdim = 1,thresh = 2),"calculate_homology")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = NULL,maxdim = 1,thresh = 2),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = 2,maxdim = 1,thresh = 2),"string")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = "calculatehomology",maxdim = 1,thresh = 2),"calculate_homology")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = NULL,maxdim = 1,thresh = 2),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_boot = 2,maxdim = 1,thresh = 2),"string")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1.1,thresh = 2),"whole")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = NA,thresh = 2),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = -1,thresh = 2),"negative")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = 0),"positive")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = NaN),"NaN")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),maxdim = 1,thresh = "2"),"numeric")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,distance_mat = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = NA),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,distance_mat = T),"square")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,p_less_than_alpha = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,p_less_than_alpha = NA),"NA")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_pvals = "F"),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = c(F,T)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_pvals = NA),"NA")
#
# # PyH parameters (ripser,ignore_infinite_cluster,calculate_representatives) are all working, tested in test-python.R
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = c(T,F)),"boolean")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,calculate_representatives = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,calculate_representatives = NA),"NA")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,num_samples = 0),"one")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,num_samples = Inf),"finite")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,alpha = NA),"NA")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,alpha = 2),"1")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,alpha = c(0.5,0.4)),"single")
#
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_subsetted = c(T,F)),"single")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "calculate_homology",maxdim = 1,thresh = 2,return_subsetted = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = Inf),"logical")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = NULL),"NULL")
# expect_error(bootstrap_persistence_thresholds(data.frame(x = 1:10,y = 1:10),FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = NA),"NA")
#
# })
# test_that("bootstrap_persistence_thresholds is computing properly",{
#
# skip_if_not_installed("TDA")
# skip_if_not_installed("TDAstats")
#
# library(TDA)
#
# D <- TDA::circleUnif(n = 50,r = 1)
#
# # ripsDiag
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# if(length(which(bs$subsetted_diag$dimension == 0)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# }
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# if(length(which(bs$subsetted_diag$dimension == 0)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# }
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,calculate_representatives = T,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$representatives,nrow(bs$diag))
# expect_lte(length(bs$thresholds),2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# expect_length(bs$subsetted_representatives,nrow(bs$subsetted_diag))
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 0),]$birth) > bs$thresholds[[1]])
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
#
# # calculate_homology
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3,return_subsetted = T)
# expect_length(bs$thresholds,2)
# expect_gt(bs$thresholds[[1]],0)
# expect_gt(bs$thresholds[[2]],0)
# if(length(which(bs$subsetted_diag$dimension == 1)) > 0)
# {
# expect_true(min(bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$death - bs$subsetted_diag[which(bs$subsetted_diag$dimension == 1),]$birth) > bs$thresholds[[2]])
# }
#
# # check on circle:
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3)
# expect_lte(length(bs$subsetted_diag$dimension),2)
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,num_samples = 3)
# expect_lte(length(bs$subsetted_diag$dimension),1)
#
# # one example by hand to verify thresholds
# D <- data.frame(x = c(0,0,0),y = c(1,2,2.5))
# diag <- diagram_to_df(TDA::ripsDiag(D,maxdimension = 0,maxscale = 2.5,library = "dionysus"))
# permuted_diag <- function(D,s)
# {
# return(TDA::ripsDiag(X = D[s,],maxdimension = 0,maxscale = 2.5,library = "dionysus"))
# }
# d1 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,1)),dim = 0,p = Inf)
# d2 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,2)),dim = 0,p = Inf)
# d3 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,3)),dim = 0,p = Inf)
# d4 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,2)),dim = 0,p = Inf)
# d5 <- diagram_distance(diag,permuted_diag(D = D,s = c(1,1,3)),dim = 0,p = Inf)
# d6 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,1)),dim = 0,p = Inf)
# d7 <- diagram_distance(diag,permuted_diag(D = D,s = c(2,2,3)),dim = 0,p = Inf)
# d8 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,1)),dim = 0,p = Inf)
# d9 <- diagram_distance(diag,permuted_diag(D = D,s = c(3,3,2)),dim = 0,p = Inf)
# d10 <- diagram_distance(diag,diag,dim = 0,p = Inf)
# unique_vals <- unique(c(d1,d2,d3,d4,d5,d6,d7,d8,d9,d10))
# thresholds <- c()
# for(i in 1:3)
# {
# for(j in 1:3)
# {
# for(k in 1:3)
# {
# thresholds <- c(thresholds,2*stats::quantile(unique_vals[c(i,j,k)],probs = 0.95)[[1]])
# }
# }
# }
# thresholds <- unique(thresholds)
# expect_true(bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 0,thresh = 2.5,num_workers = 2,num_samples = 3)$thresholds %in% thresholds)
#
# # check p-values
# D <- TDA::circleUnif(n = 100,r = 1)
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T)
# expect_lte(length(bs$pvals),2L)
# expect_true(bs$pvals[[1]] < 0.1)
# if(length(bs$pvals) == 2L)
# {
# expect_true(bs$pvals[[2]] < 0.1)
# }
#
# bs <- bootstrap_persistence_thresholds(X = D,maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,p_less_than_alpha = T,alpha = 1/31)
# expect_identical(length(bs$pvals),0L)
#
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,calculate_representatives = T,alpha = 1/31)
# expect_lte(length(bs$pvals),2L)
# expect_true(bs$pvals[[1]] < 0.1)
# if(length(bs$pvals) == 2L)
# {
# expect_true(bs$pvals[[2]] < 0.1)
# }
# bs <- bootstrap_persistence_thresholds(X = D,FUN_diag = "ripsDiag",FUN_boot = "ripsDiag",maxdim = 1,thresh = 2,return_diag = T,num_workers = 2,return_subsetted = T,return_pvals = T,calculate_representatives = T,alpha = 1/31,p_less_than_alpha = T)
# expect_identical(length(bs$subsetted_representatives),0L)
#
# })
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.