test_that("diagram_ksvm detects incorrect parameters correctly",{ D1 <- data.frame(dimension = 0,birth = 2,death = 3) D2 <- data.frame(dimension = 0,birth = 2,death = 3.1) D3 <- data.frame(dimension = 0,birth = c(2,5),death = c(3.1,6)) expect_error(diagram_ksvm(diagrams = list(D1,D2,NULL),y = c(0,1,2),num_workers = 2),"Diagrams") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),cv = NA,y = c(0,1,2),num_workers = 2),"cv") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),cv = 0,y = c(0,1,2),num_workers = 2),"cv") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = 1,cv = 2,y = c(0,1,2),num_workers = 2),"cv") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),cv = 1.1,y = c(0,1,2),num_workers = 2,dim = 1),"cv") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),cv = c(1,2),y = c(0,1,2),num_workers = 2),"cv") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),t = -1,y = c(0,1,2),num_workers = 2),"t") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = 0,sigma = 0,y = c(0,1,2),num_workers = 2),"sigma") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = NaN,y = c(0,1,2),num_workers = 2),"dim") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = 1,y = c(0,1),num_workers = 2),"number of elements") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = 1,y = c("0","1","2"),num_workers = 2),"factor") expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),dim = 1,y = as.factor(c("0","1","2")),cv = 2,num_workers = 2),"One class") }) # test_that("diagram_ksvm can accept inputs from TDA, TDAstats and diagram_to_df",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # D1 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1) # D2 = TDA::alphaComplexDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxdimension = 1) # D3 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1,library = "dionysus",location = T) # D4 = TDAstats::calculate_homology(data.frame(x = runif(50,0,1),y = runif(50,0,1)),threshold = 1) # expect_s3_class(diagram_ksvm(diagrams = list(D1,D2,D3,D4),y = c(1,2,3,4),num_workers = 2,dim = c(1)),"diagram_ksvm") # expect_error(diagram_ksvm(diagrams = list(D1,D2,D3,D4),y = c(1,2,3,4),num_workers = 2,dim = c(0)),"Inf") # expect_error(diagram_ksvm(diagrams = list(D1,D2,D3,D4),y = c(1,2,3,4),num_workers = 2,cv = 2,dim = c(0)),"Inf") # # }) # test_that("diagram_ksvm can accept precomputed distance matrices",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # D1 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1) # D2 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1,library = "dionysus",location = T) # D3 = TDAstats::calculate_homology(data.frame(x = runif(50,0,1),y = runif(50,0,1)),threshold = 1) # d0 = distance_matrix(diagrams = list(D1,D2,D3),dim = 0,num_workers = 2,distance = "fisher",sigma = 1) # d1 = distance_matrix(diagrams = list(D1,D2,D3),dim = 1,num_workers = 2,distance = "fisher",sigma = 1) # expect_s3_class(diagram_ksvm(diagrams = list(D1,D2,D3),y = c(1,2,3),distance_matrices = list(d0,d1),num_workers = 2,dim = c(0,1)),"diagram_ksvm") # # expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),y = c(1,2,3),distance_matrices = list(d0,matrix(data = c(0,1,NA,0),nrow = 2,ncol = 2,byrow = T)),num_workers = 2,dim = c(0,1)),"missing") # # expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),y = c(1,2,3),distance_matrices = list(d0,d1,d1),num_workers = 2,dim = c(0,1)),"expand.grid") # # expect_error(diagram_ksvm(diagrams = list(D1,D2,D3),y = c(1,2,3),distance_matrices = NA,num_workers = 2,dim = c(0,1)),"list") # # }) # test_that("diagram_ksvm can perform cross validation with any valid model type",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # # create diags # g <- lapply(X = 1:10,FUN = function(X){ # # if(X <= 5) # { # return(TDAstats::calculate_homology(TDA::circleUnif(n = 50),threshold = 1,dim = 1)) # } # return(TDAstats::calculate_homology(TDA::sphereUnif(n = 50,d = 2),threshold = 1,dim = 1)) # # }) # # # create models with CV # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),type = "C-svc"),"list") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),type = "C-svc"),"list") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "C-svc"),"list") # expect_type(diagram_ksvm(diagrams = g,cv = 1,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "C-svc",prob.model = T),"list") # performs cv internally anyways # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),type = "nu-svc"),"list") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "nu-svc"),"nu-svc") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),type = "C-bsvc"),"type") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "spoc-svc"),"type") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "kbb-svc"),"type") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,type = "one-svc"),"list") # # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = c(rep(1,5),rep(2,5)),type = "eps-svr"),"list") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = c(rep(1,5),rep(2,5)),type = "nu-svr"),"list") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = c(rep(1,5),rep(2,5)),type = "eps-bsvr"),"type") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",3),rep("1",3),rep("2",4))),type = "C-svc"),"list") # }) # test_that("diagram_ksvm can handle missing t",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # # create diags # g <- lapply(X = 1:10,FUN = function(X){ # # if(X <= 5) # { # return(TDAstats::calculate_homology(TDA::circleUnif(n = 50),threshold = 1,dim = 1)) # } # return(TDAstats::calculate_homology(TDA::sphereUnif(n = 50,d = 2),threshold = 1,dim = 1)) # # }) # # expect_error(diagram_ksvm(diagrams = g,cv = 1,dim = 1,y = factor(c(rep("0",5),rep("1",5))),t = NA),"t") # expect_error(diagram_ksvm(diagrams = g,cv = 1,dim = 1,y = factor(c(rep("0",5),rep("1",5))),distance_matrices = list(matrix(data = 0,nrow = 10,ncol = 10)),t = NULL),"variance") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),distance_matrices = list(matrix(data = 0,nrow = 10,ncol = 10)),t = NULL),"variance") # # create models # expect_type(diagram_ksvm(diagrams = g,cv = 1,dim = 1,y = factor(c(rep("0",5),rep("1",5))),t = NULL),"list") # expect_type(diagram_ksvm(diagrams = g,cv = 2,dim = 1,y = factor(c(rep("0",5),rep("1",5))),t = NULL),"list") # # }) # test_that("diagram_ksvm can handle zero variance distances matrices",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # # create diags and distance mats # g <- lapply(X = 1:10,FUN = function(X){ # # if(X <= 5) # { # return(TDAstats::calculate_homology(TDA::circleUnif(n = 20),threshold = 1,dim = 1)) # } # return(TDAstats::calculate_homology(TDA::sphereUnif(n = 20,d = 2),threshold = 1,dim = 1)) # # }) # D0 <- distance_matrix(diagrams = g,dim = 0,distance = "fisher",sigma = 1) # D1 <- distance_matrix(diagrams = g,dim = 1,distance = "fisher",sigma = 1) # D2 <- distance_matrix(diagrams = g,dim = 2,distance = "fisher",sigma = 1) # D3 <- D2 # D3[1,2] <- 1 # D3[2,1] <- 1 # # expect_error(diagram_ksvm(diagrams = g,cv = 1,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),t = 1,distance_matrices = list(D2,D2,D2)),"0 variance") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),t = 1,distance_matrices = list(D2,D2,D2)),"one cv fold") # expect_error(diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),t = 1,distance_matrices = list(D3,D2,D2)),"one cv fold") # # res <- diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),t = 1,distance_matrices = list(D0,D1,D2)) # expect_true(is.na(res$cv_results[3,7])) # res <- diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),distance_matrices = list(D0,D1,D2)) # expect_true(is.na(res$cv_results[3,7])) # res <- diagram_ksvm(diagrams = g,cv = 1,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),distance_matrices = list(D0,D2,D1)) # expect_true(is.na(res$cv_results[3,7])) # expect_true(res$cv_results[2,1] == 2) # # res <- diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5))),t = 1) # expect_true(is.na(res$cv_results[3,7])) # res <- diagram_ksvm(diagrams = g,cv = 2,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5)))) # expect_true(is.na(res$cv_results[3,7])) # res <- diagram_ksvm(diagrams = g,cv = 1,dim = c(0,1,2),y = factor(c(rep("0",5),rep("1",5)))) # expect_true(is.na(res$cv_results[3,7])) # # }) test_that("predict_diagram_ksvm detects incorrect parameters correctly",{ D1 <- data.frame(dimension = 0,birth = 2,death = 3) D2 <- data.frame(dimension = 0,birth = 2,death = 3.1) D3 <- data.frame(dimension = 0,birth = c(2,5),death = c(3.1,6)) ksvm <- diagram_ksvm(diagrams = list(D1,D2,D3),dim = 0,y = c(1,2,3),t = c(1,2),num_workers = 2) expect_error(predict_diagram_ksvm(new_diagrams = list(),model = ksvm,num_workers = 2),"1") expect_error(predict_diagram_ksvm(new_diagrams = NULL,model = ksvm,num_workers = 2),"NULL") expect_error(predict_diagram_ksvm(new_diagrams = list(D1,"1"),model = ksvm,num_workers = 2),"Diagrams") expect_error(predict_diagram_ksvm(new_diagrams = list(D1,D2,D3),model = list(1,2,3),num_workers = 2),"ksvm") expect_error(predict_diagram_ksvm(new_diagrams = list(D1,D2,D3),model = NULL,num_workers = 2),"supplied") }) test_that("predict_diagram_ksvm is computing correctly",{ circle <- data.frame(dimension = c(0,1,2),birth = c(0,0,0),death = c(2,2,0)) torus <- data.frame(dimension = c(0,1,1,2),birth = c(0,0,0,0),death = c(2,0.5,1.5,0.5)) sphere <- data.frame(dimension = c(0,1,2),birth = c(0,0,0),death = c(2,0,2)) circles <- lapply(X = 1:5,FUN = function(X){ t <- circle t$death <- t$death + rnorm(nrow(t),mean = 0,sd = 0.01) t[which(t$death < 0),3L] <- 0.001 return(t) }) tori <- lapply(X = 1:5,FUN = function(X){ t <- torus t$death <- t$death + rnorm(nrow(t),mean = 0,sd = 0.01) t[which(t$death < 0),3L] <- 0.001 return(t) }) spheres <- lapply(X = 1:5,FUN = function(X){ t <- sphere t$death <- t$death + rnorm(nrow(t),mean = 0,sd = 0.01) t[which(t$death < 0),3L] <- 0.001 return(t) }) diagrams <- list(circles[[1]],circles[[2]],circles[[3]],circles[[4]],circles[[5]], tori[[1]],tori[[2]],tori[[3]],tori[[4]],tori[[5]], spheres[[1]],spheres[[2]],spheres[[3]],spheres[[4]],spheres[[5]]) ksvm <- diagram_ksvm(diagrams = diagrams,dim = 1,y = as.factor(c(rep("circle",5),rep("torus",5),rep("sphere",5))),num_workers = 2) expect_equal(as.character(predict_diagram_ksvm(new_diagrams = diagrams,model = ksvm,num_workers = 2)),c(rep("circle",5),rep("torus",5),rep("sphere",5))) }) # test_that("predict_diagram_ksvm can accept inputs from TDA, TDAstats and diagram_to_df",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # D1 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1) # D2 = TDA::alphaComplexDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxdimension = 1) # D3 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1,library = "dionysus",location = T) # D4 = TDAstats::calculate_homology(data.frame(x = runif(50,0,1),y = runif(50,0,1)),threshold = 1) # ksvm = diagram_ksvm(diagrams = list(D1,D2,D3,D4),y = c(1,2,3,4),num_workers = 2,dim = c(1)) # expect_length(predict_diagram_ksvm(new_diagrams = list(D1,D2,D3,D4),model = ksvm,num_workers = 2),4) # # }) # test_that("predict_diagram_ksvm can accept pre-computed Gram matrices",{ # # skip_on_cran() # skip_if_not_installed("TDA") # skip_if_not_installed("TDAstats") # # D1 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1) # D2 = TDA::ripsDiag(data.frame(x = runif(50,0,1),y = runif(50,0,1)),maxscale = 1,maxdimension = 1,library = "dionysus",location = T) # D3 = TDAstats::calculate_homology(data.frame(x = runif(50,0,1),y = runif(50,0,1)),threshold = 1) # d0 = distance_matrix(diagrams = list(D1,D2,D3),dim = 0,num_workers = 2,sigma = 1,distance = "fisher") # d1 = distance_matrix(diagrams = list(D1,D2,D3),dim = 1,num_workers = 2,sigma = 1,distance = "fisher") # model = diagram_ksvm(diagrams = list(D1,D2,D3),y = c(1,2,3),distance_matrices = list(d0,d1),num_workers = 2,dim = c(0,1)) # if(model$best_model$dim == 0) # { # K = exp(-1*d0) # }else # { # K = exp(-1*d1) # } # K_small = K[1:2,1:2] # class(K) = "kernelMatrix" # class(K_small) = "kernelMatrix" # expect_error(predict_diagram_ksvm(model = model,K = K_small,num_workers = 2),"number") # expect_equal(predict_diagram_ksvm(model = model,K = K,num_workers = 2),predict_diagram_ksvm(new_diagrams = list(D1,D2,D3),model = model,num_workers = 2),tolerance = 1e-5) # # })