tests/testthat/test-sample.R

In regressinator: Simulate and Diagnose (Generalized) Linear Models

test_that("binomial samples have adjustable size", {
  pop <- population(x = predictor("rnorm"),
                    y = response(0, family = binomial()))
  samples <- pop |> sample_x(n = 100) |> sample_y()

  expect_equal(range(samples$y), c(0, 1))

  pop <- population(x = predictor("rnorm"),
                    y = response(0, family = binomial(), size = 2))
  samples <- pop |> sample_x(n = 100) |> sample_y()

  expect_equal(range(samples$y), c(0, 2))
})

test_that("binomial family rejects invalid size", {
  pop <- population(x = predictor("rnorm"),
                    y = response(0, family = binomial(), size = c(2, 3)))
  samples <- pop |> sample_x(n = 100)

  expect_error(sample_y(samples))

  pop <- population(x = predictor("rnorm"),
                    y = response(0, family = binomial(), size = 2.5))
  samples <- pop |> sample_x(n = 100)

  expect_error(sample_y(samples))
})

test_that("sample_x() throws classed error", {
  # invalid distribution function
  pop <- population(x = predictor("nonexistent_fn", mean = 0),
                    y = response(x, error_scale = 1))

  expect_error(sample_x(pop, 10),
               class = "regressinator_sample_dist")
})

test_that("sample_x() names multivariate predictors", {
  # unnamed multivariate
  runnamed <- function(n) {
    cbind(1:n, 1:n)
  }
  pop <- population(x = predictor(runnamed))

  expect_named(sample_x(pop, 10), c("x1", "x2"))

  # named multivariate
  rnamed <- function(n) {
    cbind(a = 1:n, b = 1:n)
  }
  pop <- population(x = predictor(rnamed))

  expect_named(sample_x(pop, 10), c("xa", "xb"))
})

test_that("sample_y() throws classed errors", {
  pop <- population(
    x = predictor("rnorm"),
    y = response(foo, error_scale = 1)
  )

  expect_error(pop |> sample_x(10) |> sample_y(),
               class = "regressinator_eval_response")

  pop <- population(
    x = predictor("rnorm"),
    y = response(x, error_scale = x2 + 2)
  )

  expect_error(pop |> sample_x(10) |> sample_y(),
               class = "regressinator_eval_error_scale")

  pop <- population(
    x = predictor("rnorm"),
    y = response(x, family = binomial(), size = foo)
  )

  expect_error(pop |> sample_x(10) |> sample_y(),
               class = "regressinator_eval_size")
})

test_that("response expr evaluated in right environment", {
  # Refer to local variables
  slope <- 2.5
  intercept <- 1.0
  pop <- population(
    x = predictor("rnorm"),
    y = response(intercept + slope * x, error_scale = 1)
  )

  expect_no_error(pop |> sample_x(10) |> sample_y())

  # refer to other environments
  foo <- function() {
    slope1 <- 2.5
    intercept1 <- 1.0
    return(population(
      x = predictor("rnorm"),
      y = response(intercept1 + slope1 * x, error_scale = 1)
    ))
  }

  expect_no_error(foo() |> sample_x(10) |> sample_y())
})

test_that("error_scale argument evaluated in right environment", {
  # Refer to prior predictors
  pop <- population(
    x = predictor("rnorm"),
    y = response(x, error_scale = x**2)
  )

  expect_no_error(pop |> sample_x(10) |> sample_y())

  # Refer to local variables
  sigma <- 2
  pop <- population(
    x = predictor("rnorm"),
    y = response(x, error_scale = sigma)
  )

  expect_no_error(pop |> sample_x(10) |> sample_y())
})

test_that("binomial response size argument evaluated in right environment", {
  # Should be able to refer to other predictors
  pop <- population(
    x = predictor("rpois", lambda = 10),
    y = response(x / 10, family = binomial(), size = x)
  )

  expect_no_error(pop |>
                    sample_x(10) |>
                    sample_y())

  # Should also be able to refer to local variables
  s <- 14
  pop <- population(
    x = predictor("rnorm"),
    y = response(x, family = binomial(), size = s)
  )

  expect_no_error(out <- pop |>
                    sample_x(10) |>
                    sample_y())
  expect_true(all(out$y <= s))

  # And variables in different environments
  foo <- function() {
    q <- 20
    return(population(
      x = predictor("rnorm"),
      y = response(x, family = binomial(), size = q)
    ))
  }

  expect_no_error(out <- foo() |>
                    sample_x(10) |>
                    sample_y())
  expect_true(all(out$y <= 20))
})