tests/testthat/test-svm.R

In shaelebrown/TDAML: Machine Learning and Inference for Topological Data Analysis

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)
#   
# })