tests/testthat/test-user-defined.R

In rdist: Calculate Pairwise Distances

context("minkowski")

test_that("user-defined metric works as expected", {
  x <- matrix(rnorm(200), nrow = 100)
  
  # euclidean metric
  euclidean_function <- function(x, y){
    sqrt(sum((x-y)^2))
  }
  dist_dist <- dist(x, method = "euclidean")
  dist_mat <- as.matrix(dist_dist)
  attr(dist_mat, "dimnames") <- NULL
  # check pdist and cdist 
  expect_equivalent(dist_dist, rdist(x, metric = euclidean_function))
  expect_equivalent(dist_mat, pdist(x, metric = euclidean_function))
  expect_equivalent(dist_mat, cdist(x, x, metric = euclidean_function))
  expect_equivalent(dist_mat[1:2, 3:100], 
                    cdist(x[1:2, ], x[3:100, ], metric = euclidean_function))
  expect_equivalent(dist_mat[1, 2:100, drop = FALSE], 
                    cdist(x[1, , drop = FALSE], x[2:100, , drop = FALSE], metric = euclidean_function))
  
  # manhattan metric
  manhattan_function <- function(x, y){
    sum(abs(x-y))
  }
  dist_dist <- dist(x, method = "manhattan")
  dist_mat <- as.matrix(dist_dist)
  attr(dist_mat, "dimnames") <- NULL
  # check pdist and cdist 
  expect_equivalent(dist_dist, rdist(x, metric = manhattan_function))
  expect_equivalent(dist_mat, pdist(x, metric = manhattan_function))
  expect_equivalent(dist_mat, cdist(x, x, metric = manhattan_function))
  expect_equivalent(dist_mat[1:2, 3:100], 
                    cdist(x[1:2, ], x[3:100, ], metric = manhattan_function))
  expect_equivalent(dist_mat[1, 2:100, drop = FALSE], 
                    cdist(x[1, , drop = FALSE], x[2:100, , drop = FALSE], metric = manhattan_function))
  
  # maximum metric 
  maximum_function <- function(x, y){
    max(abs(x-y))
  }
  dist_dist <- dist(x, method = "maximum")
  dist_mat <- as.matrix(dist_dist)
  attr(dist_mat, "dimnames") <- NULL
  # check pdist and cdist 
  expect_equivalent(dist_dist, rdist(x, metric = maximum_function))
  expect_equivalent(dist_mat, pdist(x, metric = maximum_function))
  expect_equivalent(dist_mat, cdist(x, x, metric = maximum_function))
  expect_equivalent(dist_mat[1:2, 3:100], 
                    cdist(x[1:2, ], x[3:100, ], metric = maximum_function))
  expect_equivalent(dist_mat[1, 2:100, drop = FALSE], 
                    cdist(x[1, , drop = FALSE], x[2:100, , drop = FALSE], metric = maximum_function))
})