tests/testthat/test-utils.R

In WData: Statistical Inference for Weighted Data

test_that(".check_biased_sample() handles valid inputs", {
  result <- .check_biased_sample(1:10, function(y) y + 1)

  expect_type(result, "list")
  expect_named(result, c("data.name", "n", "y", "w", "yw", "weights", "uw", "uwb", "has.na"))
  expect_equal(result$n, 10)
  expect_type(result$w, "closure")
  expect_length(result$y, 10)
  expect_length(result$yw, 10)
})

test_that(".check_biased_sample() throws errors for invalid inputs", {
  expect_error(.check_biased_sample("not_numeric", function(y) y + 1), "invalid 'y'")
  expect_error(.check_biased_sample(c(1, NA), function(y) y + 1), "need at least 2 data points")
  expect_error(.check_biased_sample(1:10, "not_a_function"), "argument 'w' must be a function")
  expect_error(.check_biased_sample(1:10, function(y) NA), "function 'w' must be bounded")
})

test_that(".get_kernel_values() handles valid inputs", {
  kernels <- c("gaussian", "epanechnikov", "rectangular", "triangular", "biweight", "cosine", "optcosine")

  lapply(kernels, function(k) {
    result <- .get_kernel_values(k)

    expect_type(result, "list")
    expect_named(result, c(
      "kernel_function_density",
      "kernel_function_distribution",
      "kernel_function_density_deriv1",
      "kernel_function_density_deriv2",
      "kernel_function_conv",
      "kernel_r",
      "kernel_r_deriv1",
      "kernel_r_deriv2",
      "kernel_eta",
      "kernel_kappa"
    ))
    expect_type(result$kernel_function_density, "closure")
  })
})

test_that(".get_kernel_values() throws errors for invalid inputs", {
  expect_error(.get_kernel_values("unknown_kernel"), "unknown kernel")
})

test_that(".get_kernel_values() is consistent", {
  kernels <- c(
    "gaussian", "epanechnikov", "rectangular",
    "triangular",
    "biweight", "cosine", "optcosine"
  )

  for (i in kernels) {
    k <- .get_kernel_values(i)

    expect_lt(abs(integrate(
      Vectorize(function(u) k$kernel_function_density(u)^2),
      -4, 4
    )$value - k$kernel_r), 0.01)

    expect_lt(abs(integrate(
      Vectorize(function(u) k$kernel_function_density_deriv1(u)^2),
      -4, 4
    )$value - k$kernel_r_deriv1), 0.01)

    expect_lt(abs(integrate(
      Vectorize(function(u) k$kernel_function_density_deriv2(u)^2),
      -4, 4
    )$value - k$kernel_r_deriv2), 0.01)

    expect_lt(abs(integrate(
      Vectorize(function(u) u^2 * k$kernel_function_density(u)),
      -4, 4
    )$value - k$kernel_eta), 0.01)

    expect_lt(abs(integrate(
      Vectorize(function(u) 2 * u * k$kernel_function_density(u) * k$kernel_function_distribution(u)),
      -4, 4
    )$value - k$kernel_kappa), 0.01)
  }
})


test_that(".simpsons_rule() handles valid inputs", {
  x <- seq(0, 1, length.out = 11)
  fx <- x^2

  result <- .simpsons_rule(x, fx)
  expect_type(result, "double")
  expect_true(abs(result - 1 / 3) < 1e-3) # Expected integral of x^2 from 0 to 1 is 1/3
})

test_that(".validate_number() handles valid inputs", {
  expect_silent(.validate_number(1, "test"))
  expect_silent(.validate_number(3.14, "test"))
  expect_silent(.validate_number(-5, "test"))
})

test_that(".validate_number() throws errors for invalid inputs", {
  expect_error(.validate_number(NA, "test"), "Invalid test")
  expect_error(.validate_number(NaN, "test"), "Invalid test")
  expect_error(.validate_number(Inf, "test"), "Invalid test")
  expect_error(.validate_number("string", "test"), "Invalid test")
  expect_error(.validate_number(c(1, 2), "test"), "Invalid test")
  expect_error(.validate_number(list(1), "test"), "Invalid test")
})

test_that(".get_bandwidth_grid() handles valid inputs", {
  grid <- .get_bandwidth_grid(nh = 5, lower = 0.1, upper = 1, tol = 0.01, plot = FALSE)

  expect_type(grid, "double")
  expect_length(grid, 5)
  expect_true(all(grid >= 0.1 & grid <= 1))
})

test_that(".get_bandwidth_grid() throws errors for invalid inputs", {
  expect_error(.get_bandwidth_grid(nh = 0, lower = 0.1, upper = 1, tol = 0.01, plot = FALSE), "'nh' must be a positive integer")
  expect_error(.get_bandwidth_grid(nh = 5, lower = -1, upper = 1, tol = 0.01, plot = FALSE), "'from' and 'to' must be positive numbers")
  expect_error(.get_bandwidth_grid(nh = 5, lower = 0.5, upper = 0.1, tol = 0.01, plot = FALSE), "'lower' must be smaller than 'upper'")
})

test_that(".get_xaxn_grid() handles valid inputs", {
  result <- .get_xaxn_grid(1:10, from = 1, to = 10, nb = 5, plot = FALSE)

  expect_type(result, "list")
  expect_named(result, c("y.seq", "from", "to"))
  expect_length(result$y.seq, 5)
  expect_equal(result$from, 1)
  expect_equal(result$to, 10)
})

test_that(".get_xaxn_grid() throws errors for invalid inputs", {
  expect_error(.get_xaxn_grid(1:10, y.seq = NULL, from = 10, to = 1, nb = 5, plot = FALSE), "'y.seq' must be a numeric vector")
  expect_error(.get_xaxn_grid(1:10, from = 10, to = 1, nb = 5, plot = FALSE), "'from' must be smaller than 'to'")
  expect_error(.get_xaxn_grid(1:10, from = 1, to = 10, nb = -5, plot = FALSE), "'nb' must be a positive integer")
})