tests/testthat/test-core_edge_cases.R

In jsdtools: Jensen-Shannon Divergence Estimation, Confidence Intervals, and Distribution Plots

test_that("unequal sample sizes are allowed for continuous JSD", {
  set.seed(1)
  x <- rnorm(80, mean = 0, sd = 1)
  y <- rnorm(150, mean = 0.5, sd = 1)

  res <- jsd(x, y, type = "continuous")

  expect_s3_class(res, "jsd_estimate")
  expect_equal(res$type, "continuous")
  expect_true(is.finite(res$estimate))
  expect_true(res$estimate >= 0)
})

test_that("unequal sample sizes are allowed for discrete JSD", {
  set.seed(1)
  x <- sample(0:3, size = 70, replace = TRUE)
  y <- sample(0:3, size = 160, replace = TRUE)

  res <- jsd(x, y, type = "discrete")

  expect_s3_class(res, "jsd_estimate")
  expect_equal(res$type, "discrete")
  expect_true(is.finite(res$estimate))
  expect_true(res$estimate >= 0)
})

test_that("missing values are removed when na_rm = TRUE for continuous data", {
  set.seed(1)
  x <- rnorm(100)
  y <- rnorm(100, 0.5)

  x[c(3, 8, 20)] <- NA
  y[c(2, 15)] <- NA

  expect_no_error(
    res <- jsd(x, y, type = "continuous")
  )

  expect_true(is.finite(res$estimate))
})

test_that("missing values are removed when na_rm = TRUE for discrete data", {
  x <- c(0, 1, 2, 3, NA, 2, 1)
  y <- c(0, 0, 1, 2, 3, NA, 3, 2)

  expect_no_error(
    res <- jsd(x, y, type = "discrete")
  )

  expect_true(is.finite(res$estimate))
})

test_that("base = 2 and base = exp(1) both work", {
  set.seed(1)
  x <- rnorm(100)
  y <- rnorm(100, 0.5)

  res_bits <- jsd(x, y, type = "continuous", base = 2)
  res_nats <- jsd(x, y, type = "continuous", base = exp(1))

  expect_true(is.finite(res_bits$estimate))
  expect_true(is.finite(res_nats$estimate))
  expect_true(res_bits$estimate >= 0)
  expect_true(res_nats$estimate >= 0)
})

test_that("invalid base throws an error", {
  set.seed(1)
  x <- rnorm(50)
  y <- rnorm(50)

  expect_error(jsd(x, y, base = 10), "base")
  expect_error(jsd(x, y, base = 1), "base")
})

test_that("discrete character data are supported", {
  x <- c("low", "mid", "high", "mid", "low")
  y <- c("low", "low", "mid", "high", "high")

  res <- jsd(x, y, type = "discrete")

  expect_s3_class(res, "jsd_estimate")
  expect_equal(res$type, "discrete")
  expect_true(is.finite(res$estimate))
})