tests/testthat/test-dist-canberra.R

In HajkD/philentropy: Similarity and Distance Quantification Between Probability Functions

context("Test implementation of canberra distance ...")

P <- 1:10 / sum(1:10)
Q <- 20:29 / sum(20:29)
V <- -10:10
W <- -20:0

# function to test distance matrix functionality
# for different distance measures
test_dist_matrix <- function(x, FUN) {
  dist.fun <- match.fun(FUN)
  res.dist.matrix <- matrix(NA_real_, nrow(x), nrow(x))
  
  for (i in 1:nrow(x)) {
    for (j in 1:nrow(x)) {
      res.dist.matrix[i, j] <- dist.fun(x[i, ], x[j, ])
    }
  }
  return(res.dist.matrix[lower.tri(res.dist.matrix, diag = FALSE)])
}



test_canberra_dist <- function(P, Q) {
  sum(abs((P) - (Q)) / ((P) + (Q)))
}

test_that("distance(method = 'canberra') computes the correct distance value.",
          {
            
            expect_equal(as.vector(philentropy::distance(rbind(P, Q), method = "canberra")),
                         test_canberra_dist(P, Q))
            
            expect_equal(as.vector(philentropy::distance(rbind(P, Q), method = "canberra")),
                         as.vector(stats::dist(base::rbind(P, Q), method = "canberra")))
            
            # test correct computation of distance matrix
            distMat <-
              rbind(rep(0.2, 5), rep(0.1, 5), c(5, 1, 7, 9, 5))
            dist.vals <-
              distance(distMat, method = "canberra")
            
            expect_equal(dist.vals[lower.tri(dist.vals, diag = FALSE)],
                             test_dist_matrix(distMat, FUN = test_canberra_dist))
            
          })


test_that(
  "distance(method = 'canberra') computes the correct distance value when P_i and Q_i are 0 -> 0/0 is then replaced by 0.",
  {
    A <- c(0, 0.25, 0.25, 0, 0.25, 0.25)
    B <- c(0, 0, 0.25, 0.25, 0.25, 0.25)
    
    canb <- function(x, y) {
      dist <- vector(mode = "numeric", length = 1)
      dist <- 0
      
      for (i in 1:length(x)) {
        if ((abs(x[i] - y[i]) == 0) | ((x[i] + y[i]) == 0)) {
          dist = dist
        } else {
          dist = dist + (abs(x[i] - y[i]) / ((x[i]) + (y[i])))
        }
        
      }
      
      return(dist)
    }
    
    expect_equal(as.vector(philentropy::distance(rbind(A, B), method = "canberra")), canb(A, B))
    
    
  }
)