tests/testthat/test-distance.R

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

test_that("diagram_distance detects incorrect parameters correctly",{
  
  D = data.frame(dimension = c(0),birth = c(0),death = c(1))
  expect_error(diagram_distance(D1 = NULL,D2 = D,dim = 1),"TDA/TDAstats")
  expect_error(diagram_distance(D1 = D,D2 = NULL,dim = 1),"TDA/TDAstats")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = "2"),"numeric")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = 1,p = "2"),"numeric")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = 1,distance = "Wasserstein"),"distance must")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = 1,distance = "fisher",sigma = NA),"sigma must")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = 1,distance = "fisher",sigma = 1,rho = 0),"positive")
  expect_error(diagram_distance(D1 = D,D2 = D,dim = 1,distance = "fisher",sigma = 1,rho = NA),"NA")
  
})

# test_that("diagram_distance can accept inputs from either TDA/TDAstats homology output or diagram_to_df function, with or without cycle location",{
# 
#   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)
#   D5 = TDAstats::calculate_homology(data.frame(x = runif(50,0,1),y = runif(50,0,1)),threshold = 10,dim = 1)
#   expect_gte(diagram_distance(D1 = D1,D2 = D2,dim = 1),0)
#   expect_gte(diagram_distance(D1 = diagram_to_df(D1),D2 = D2,dim = 1),0)
#   expect_gte(diagram_distance(D1 = D1,D2 = diagram_to_df(D2),dim = 1),0)
#   expect_gte(diagram_distance(D1 = D3,D2 = diagram_to_df(D2),dim = 1),0)
#   expect_gte(diagram_distance(D1 = D1,D2 = diagram_to_df(D3),dim = 1),0)
#   expect_gte(diagram_distance(D1 = D1,D2 = D4,dim = 1),0)
#   expect_error(diagram_distance(D1 = D1,D2 = D2,dim = 0),"Inf")
# 
# })

test_that("diagram_distance is computing correctly",{
  
  D1 = data.frame(dimension = 0,birth = 2,death = 3)
  D2 = data.frame(dimension = 0,birth = c(2,5),death = c(3.1,6))
  expect_identical(diagram_distance(D1,D2,dim = 0,distance = "wasserstein",p = 2),sqrt(0.1^2+0.5^2))
  expect_identical(diagram_distance(D2,D1,dim = 0,distance = "wasserstein",p = 2),sqrt(0.1^2+0.5^2))
  expect_identical(diagram_distance(D1,D2,dim = 0,distance = "wasserstein",p = 3),(0.1^3+0.5^3)^(1/3))
  expect_equal(diagram_distance(D1 = D1,D2 = D2,distance = "fisher",dim = 0,sigma = 1),diagram_distance(D1 = D2,D2 = D1,distance = "fisher",dim = 0,sigma = 1))
  expect_identical(diagram_distance(D1 = D1,D2 = D2,p = Inf,distance = "wasserstein",dim = 0),0.5)
  expect_identical(diagram_distance(D1 = D2,D2 = D1,p = Inf,distance = "wasserstein",dim = 0),0.5)
  expect_identical(diagram_distance(D1 = D1,D2 = D1,p = Inf,distance = "wasserstein",dim = 0),0)
  expect_identical(diagram_distance(D1 = D1,D2 = D1,p = 2,distance = "wasserstein",dim = 0),0)
  expect_identical(diagram_distance(D1 = D1,D2 = D1,distance = "fisher",sigma = 1,dim = 0),0)
  expect_identical(diagram_distance(D1 = D1,D2 = D2,dim = 1),0)
  
  D1$dimension = 1
  expect_identical(diagram_distance(D1 = D1,D2 = D2,dim = 1,p = 2,distance = "wasserstein"),sqrt(0.5^2))
  expect_identical(diagram_distance(D1 = D1,D2 = D2,dim = 1,p = Inf,distance = "wasserstein"),0.5)
  expect_identical(diagram_distance(D1 = D2,D2 = D1,dim = 1,p = 2,distance = "wasserstein"),sqrt(0.5^2))
  expect_identical(diagram_distance(D1 = D2,D2 = D1,dim = 1,p = Inf,distance = "wasserstein"),0.5)
  
  # this example was picked the TDA function wasserstein disagrees with the actual minimum values
  # for p = 2,3, but diagram_distance gets the correct answer
  D1 = data.frame(dimension = c(0,0),birth = c(0,0),death = c(0.9640122,1.3467424))
  D2 = data.frame(dimension = c(0,0),birth = c(0,0),death = c(1.233867,1.398447))
  phom1 = D1
  phom2 = D2
  
  D1_subset <- D1[,2:3]
  D2_subset <- D2[,2:3]
  diag1 <- D1_subset[0,]
  diag2 <- D2_subset[0,]
  D1_subset <- D1_subset[which(D1_subset[,1] != D1_subset[,2]),]
  D2_subset <- D2_subset[which(D2_subset[,1] != D2_subset[,2]),]
  if(nrow(D1_subset) > 0)
  {
    for(i in 1:nrow(D1_subset))
    {
      proj_diag <- mean(as.numeric(D1_subset[i,]))
      diag1 <- rbind(diag1,data.frame(birth = proj_diag,death = proj_diag))
    }
  }
  if(nrow(D2_subset) > 0)
  {
    for(i in 1:nrow(D2_subset))
    {
      proj_diag <- mean(as.numeric(D2_subset[i,]))
      diag2 <- rbind(diag2,data.frame(birth = proj_diag,death = proj_diag))
    }
  }
  D1_subset <- rbind(D1_subset,diag2)
  D2_subset <- rbind(D2_subset,diag1)
  
  dist_mat_bottleneck <- as.matrix(rdist::cdist(D1_subset,D2_subset,metric = "maximum"))
  dist_mat_2 <- dist_mat_bottleneck^2
  dist_mat_3 <- dist_mat_bottleneck^3
  
  min_bottleneck = Inf
  min_wass_2 = Inf
  min_wass_3 = Inf
  
  perms = matrix(data = c(1,2,3,4,1,2,4,3,1,3,2,4,1,3,4,2,1,4,2,3,1,4,3,2,2,1,3,4,2,1,4,3,2,3,1,4,2,3,4,1,2,4,1,3,2,4,3,1,3,1,2,4,3,1,4,2,3,2,1,4,3,2,4,1,3,4,1,2,3,4,2,1,4,1,2,3,4,1,3,2,4,2,1,3,4,2,3,1,4,3,1,2,4,3,2,1),nrow = 24,ncol = 4,byrow = T)
  class(perms) <- c("matrix","array")
  
  for(i in 1:nrow(perms))
  {
    for(j in 1:nrow(perms))
    {
      if(i != j)
      {
        temp = cbind(data.frame(x = perms[i,]),data.frame(y = perms[j,]))
        temp = as.matrix(temp[which(temp[,1] <= (nrow(D1_subset) - nrow(diag2)) | temp[,2] <= (nrow(D2_subset) - nrow(diag1))),])
        if(max(dist_mat_bottleneck[temp]) < min_bottleneck)
        {
          min_bottleneck <- max(dist_mat_bottleneck[temp])
        }
        if(sqrt(sum(dist_mat_2[temp])) < min_wass_2)
        {
          min_wass_2 <- sqrt(sum(dist_mat_2[temp]))
        }
        if((sum(dist_mat_3[temp]))^(1/3) < min_wass_3)
        {
          min_wass_3 <- (sum(dist_mat_3[temp]))^(1/3)
        }
      }
    }
  }
  
  expect_equal(diagram_distance(phom1,phom2,p = 2),min_wass_2)
  expect_equal(diagram_distance(phom1,phom2,p = 3),min_wass_3)
  expect_equal(diagram_distance(phom1,phom2,p = Inf),min_bottleneck)
  
  # expect_equal(diagram_distance(phom1,phom2,distance = "fisher",sigma = 1),diagram_distance(phom1,phom2,distance = "fisher",sigma = 1,rho = 0.0001),tolerance = 0.0001)
  
})

test_that("distance_matrix 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(distance_matrix(diagrams = list(D1,D2,D3),num_workers = 0),"num_workers")
  expect_error(distance_matrix(diagrams = list(D1,D2,D3),num_workers = "2"),"num_workers")
  expect_error(distance_matrix(diagrams = list(D1,D2,D3),num_workers = 1.1),"whole")
  
})

test_that("distance_matrix is computing 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))
  m1 <- matrix(data = c(0,diagram_distance(D1,D2,dim = 0,p = 2,distance = "wasserstein"),diagram_distance(D1,D2,dim = 0,p = 2,distance = "wasserstein"),0),byrow = T,nrow = 2,ncol = 2)
  m2 <- matrix(data = c(0,diagram_distance(D1,D2,dim = 0,p = 3,distance = "wasserstein"),diagram_distance(D1,D3,dim = 0,p = 3,distance = "wasserstein"),diagram_distance(D1,D2,dim = 0,p = 3,distance = "wasserstein"),0,diagram_distance(D2,D3,dim = 0,p = 3,distance = "wasserstein"),diagram_distance(D1,D3,dim = 0,p = 3,distance = "wasserstein"),diagram_distance(D3,D2,dim = 0,p = 3,distance = "wasserstein"),0),byrow = T,nrow = 3,ncol = 3)
  m3 <- matrix(data = c(0,diagram_distance(D1,D3,dim = 0,distance = "fisher",sigma = 1),diagram_distance(D1,D2,dim = 0,distance = "fisher",sigma = 1),diagram_distance(D3,D2,dim = 0,distance = "fisher",sigma = 1)),byrow = T,nrow = 2,ncol = 2)
  expect_identical(distance_matrix(diagrams = list(D1,D2),dim = 0,distance = "wasserstein",p = 2,num_workers = 2),m1)
  expect_equal(distance_matrix(diagrams = list(D1,D2,D3),dim = 0,distance = "wasserstein",p = 3,num_workers = 2),m2)
  expect_equal(distance_matrix(diagrams = list(D1,D2),other_diagrams = list(D1,D3),dim = 0,distance = "fisher",sigma = 1,num_workers = 2),m3)
  # expect_equal(distance_matrix(diagrams = list(D1,D2),other_diagrams = list(D1,D3),dim = 0,distance = "fisher",sigma = 1,num_workers = 2,rho = 0.00001),m3,tolerance = 0.001)
  
})