tests/testthat/test-egenvar-dist.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

test_that("egenvar creates row-wise and grouped variables", {
  d <- data.frame(
    id = c(1, 1, 2, 3),
    sex = c("F", "F", "M", "M"),
    q1 = c(2, 4, 3, NA_real_),
    q2 = c(3, 5, 2, 4),
    q3 = c(4, NA_real_, 1, 5),
    bmi = c(20, 22, 25, 27)
  )

  egenvar(d,
    rmin = rowmin(q1:q3),
    rmax = rowmax(q1:q3),
    rmean = rowmean(q1:q3),
    rmiss = rowmiss(q1:q3)
  )
  expect_equal(d$rmin, c(2, 4, 1, 4))
  expect_equal(d$rmax, c(4, 5, 3, 5))
  expect_equal(d$rmean, c(3, 4.5, 2, 4.5))
  expect_equal(d$rmiss, c(0, 1, 0, 1))

  egenvar(d,
    mean_bmi = mean(bmi),
    n_group = n(),
    sequence = seq(),
    by = sex
  )
  expect_equal(d$mean_bmi, c(21, 21, 26, 26))
  expect_equal(d$n_group, rep(2, 4))
  expect_equal(d$sequence, c(1, 2, 1, 2))

  egenvar(d, person_group = group(id, sex), first_id = tag(id))
  expect_equal(d$person_group, c(1, 1, 2, 3))
  expect_equal(d$first_id, c(1, 0, 1, 1))
})

test_that("distdata returns all common binomial tail probabilities", {
  z <- distdata("binomial", n = 10, p = .2, x = 3,
                plot = FALSE, show = FALSE)
  tab <- z$raw$point
  val <- setNames(tab$Value, tab$Quantity)

  expect_equal(unname(val["P(X = x)"]), stats::dbinom(3, 10, .2), tolerance = 1e-6)
  expect_equal(unname(val["P(X < x)"]), stats::pbinom(2, 10, .2), tolerance = 1e-6)
  expect_equal(unname(val["P(X <= x)"]), stats::pbinom(3, 10, .2), tolerance = 1e-6)
  expect_equal(unname(val["P(X > x)"]), 1 - stats::pbinom(3, 10, .2), tolerance = 1e-6)
  expect_equal(unname(val["P(X >= x)"]), 1 - stats::pbinom(2, 10, .2), tolerance = 1e-6)
})

test_that("distdata handles intervals, quantiles and parameter aliases", {
  z <- distdata("normal", mean = 100, sd = 15,
                lower = 85, upper = 115, probs = c(.025, .5, .975),
                plot = FALSE, show = FALSE)
  expect_equal(z$raw$range$Value[1], stats::pnorm(115, 100, 15) - stats::pnorm(85, 100, 15), tolerance = 1e-6)
  expect_equal(z$raw$quantiles$Quantile, stats::qnorm(c(.025, .5, .975), 100, 15), tolerance = 1e-5)

  nb <- distdata("nbinom", size = 2, mu = 5, x = 0:3,
                 plot = FALSE, show = FALSE)
  expect_s3_class(nb, "r4vn_distdata")

  bb <- distdata("betabinom", n = 20, p = .3, rho = .1, x = 0:3,
                 plot = FALSE, show = FALSE)
  expect_s3_class(bb, "r4vn_distdata")
})

test_that("distdata uses a seed only when supplied", {
  a <- distdata("poisson", lambda = 2, nsim = 20, seed = 17,
                plot = FALSE, show = FALSE)$raw$simulation
  b <- distdata("poisson", lambda = 2, nsim = 20, seed = 17,
                plot = FALSE, show = FALSE)$raw$simulation
  expect_identical(a, b)
})

test_that("distdata handles teaching aliases and rejects irrelevant parameters", {
  b1 <- distdata("binomial", trials = 10, prob = .2, x = 3,
                 plot = FALSE, show = FALSE)
  expect_equal(b1$raw$parameters$n, 10)
  expect_equal(b1$raw$parameters$p, .2)

  g1 <- distdata("gamma", shape = 2, scale = 4, x = 2,
                 plot = FALSE, show = FALSE)
  expect_equal(g1$raw$parameters$rate, .25)

  du <- distdata("discreteuniform", min = 1, max = 6,
                 probs = c(0, 1), plot = FALSE, show = FALSE)
  expect_equal(du$raw$quantiles$Quantile, c(1, 6))

  expect_error(
    distdata("normal", mean = 0, sd = 1, lambda = 2,
             plot = FALSE, show = FALSE),
    "Unused parameter"
  )
})

test_that("egenvar accepts positional percentile and ranking options", {
  d <- data.frame(g = c("A", "A", "B", "B"), x = c(1, 3, 2, 8))
  egenvar(d, q75 = pctile(x, 75), rmin = rank(x, "min"), by = g)
  expect_equal(d$q75, c(2.5, 2.5, 6.5, 6.5))
  expect_equal(d$rmin, c(1, 2, 1, 2))
})