tests/testthat/test-makeScalesRegression.R

In LikertMakeR: Synthesise and Correlate Likert Scale and Rating-Scale Data Based on Summary Statistics

# tests/testthat/test-makeScalesRegression.R

test_that("makeScalesRegression: basic generation with provided IV correlation matrix", {
  set.seed(123)

  iv_corr <- matrix(c(1.0, 0.3, 0.3, 1.0), nrow = 2, byrow = TRUE)
  n <- 80L

  res <- suppressWarnings(
    makeScalesRegression(
      n = n,
      beta_std = c(0.4, 0.3),
      r_squared = 0.35,
      iv_cormatrix = iv_corr,
      iv_means = c(3.0, 3.5),
      iv_sds = c(1.0, 0.9),
      dv_mean = 3.8,
      dv_sd = 1.1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5,
      items_iv = 4,
      items_dv = 4,
      var_names = c("Attitude", "Intention", "Behaviour")
    )
  )

  # Structure
  testthat::expect_s3_class(res, "makeScalesRegression")
  testthat::expect_true(is.list(res))
  testthat::expect_true(is.data.frame(res$data))

  testthat::expect_identical(nrow(res$data), n)
  testthat::expect_identical(ncol(res$data), 3L)
  testthat::expect_identical(colnames(res$data), c("Attitude", "Intention", "Behaviour"))

  # Full correlation matrix has correct dim and names
  testthat::expect_true(is.matrix(res$full_cormatrix))
  testthat::expect_identical(dim(res$full_cormatrix), c(3L, 3L))
  testthat::expect_identical(
    rownames(res$full_cormatrix),
    c("Attitude", "Intention", "Behaviour")
  )

  # R-squared achieved is close to target (allowing for simulation noise)
  ach_r2 <- res$achieved_stats$r_squared
  testthat::expect_true(is.numeric(ach_r2))
  testthat::expect_lt(abs(ach_r2 - 0.35), 0.05)

  # Standardised betas achieved roughly match target (ignore names)
  testthat::expect_equal(
    unname(res$achieved_stats$beta_std),
    c(0.4, 0.3),
    tolerance = 0.12
  )

  # Means and SDs are in the right ballpark for IVs and DV (ignore names)
  targ_means <- c(res$target_stats$iv_means, res$target_stats$dv_mean)
  targ_sds <- c(res$target_stats$iv_sds, res$target_stats$dv_sd)

  ach_means <- c(res$achieved_stats$iv_means, res$achieved_stats$dv_mean)
  ach_sds <- c(res$achieved_stats$iv_sds, res$achieved_stats$dv_sd)

  testthat::expect_equal(unname(ach_means), targ_means, tolerance = 0.30)
  testthat::expect_equal(unname(ach_sds), targ_sds, tolerance = 0.35)
})


test_that("makeScalesRegression: optimisation mode works when iv_cormatrix is NULL", {
  set.seed(456)

  n <- 120L
  k <- 3L

  res <- suppressMessages(
    makeScalesRegression(
      n = n,
      beta_std = c(0.3, 0.25, 0.2),
      r_squared = 0.40,
      iv_cormatrix = NULL, # optimisation mode
      iv_cor_mean = 0.3,
      iv_cor_variance = 0.02,
      iv_cor_range = c(-0.7, 0.7),
      iv_means = c(3.0, 3.2, 2.8),
      iv_sds = c(1.0, 0.9, 1.1),
      dv_mean = 3.5,
      dv_sd = 1.0,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5,
      items_iv = 4,
      items_dv = 5
    )
  )

  # Structure of result
  testthat::expect_s3_class(res, "makeScalesRegression")
  testthat::expect_true(is.list(res$optimisation_info))
  testthat::expect_true(is.data.frame(res$data))
  testthat::expect_identical(nrow(res$data), n)
  testthat::expect_identical(ncol(res$data), k + 1L)

  # Default variable names are IV1..IVk, DV
  testthat::expect_identical(
    colnames(res$data),
    c(paste0("IV", seq_len(k)), "DV")
  )

  # Optimised IV correlation matrix in target_stats has correct shape
  testthat::expect_true(is.matrix(res$target_stats$iv_cormatrix))
  testthat::expect_identical(dim(res$target_stats$iv_cormatrix), c(k, k))

  # iv_dv_cors has length k and names of IVs
  testthat::expect_length(res$iv_dv_cors, k)
  testthat::expect_identical(names(res$iv_dv_cors), paste0("IV", seq_len(k)))

  # Achieved R-squared is reasonably close to target, given optimisation & simulation
  ach_r2 <- res$achieved_stats$r_squared
  testthat::expect_lt(abs(ach_r2 - 0.40), 0.08)
})

test_that("makeScalesRegression: r_squared outside [0, 1] throws error", {
  set.seed(1)
  iv_corr <- diag(2)

  testthat::expect_error(
    makeScalesRegression(
      n = 50L,
      beta_std = c(0.4, 0.3),
      r_squared = 1.2, # invalid
      iv_cormatrix = iv_corr,
      iv_means = c(3, 3.5),
      iv_sds = c(1, 0.9),
      dv_mean = 4,
      dv_sd = 1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5
    ),
    regexp = "r_squared must be between 0 and 1"
  )
})

test_that("makeScalesRegression: iv_cormatrix dimension mismatch throws error", {
  set.seed(2)
  iv_corr <- diag(3) # 3x3, but only 2 betas

  testthat::expect_error(
    makeScalesRegression(
      n = 40L,
      beta_std = c(0.4, 0.3),
      r_squared = 0.25,
      iv_cormatrix = iv_corr,
      iv_means = c(3, 3),
      iv_sds = c(1, 1),
      dv_mean = 4,
      dv_sd = 1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5
    ),
    regexp = "iv_cormatrix dimensions must match number of IVs"
  )
})

test_that("makeScalesRegression: iv_means / iv_sds length mismatch throws error", {
  set.seed(3)
  iv_corr <- diag(3)

  testthat::expect_error(
    makeScalesRegression(
      n = 40L,
      beta_std = c(0.4, 0.3, 0.2),
      r_squared = 0.25,
      iv_cormatrix = iv_corr,
      iv_means = c(3, 3), # too short
      iv_sds = c(1, 1, 1),
      dv_mean = 4,
      dv_sd = 1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5
    ),
    regexp = "iv_means and iv_sds must have same length as beta_std"
  )

  testthat::expect_error(
    makeScalesRegression(
      n = 40L,
      beta_std = c(0.4, 0.3, 0.2),
      r_squared = 0.25,
      iv_cormatrix = iv_corr,
      iv_means = c(3, 3, 3),
      iv_sds = c(1, 1), # too short
      dv_mean = 4,
      dv_sd = 1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5
    ),
    regexp = "iv_means and iv_sds must have same length as beta_std"
  )
})

test_that("makeScalesRegression: var_names length mismatch throws error", {
  set.seed(4)
  iv_corr <- diag(2)

  testthat::expect_error(
    makeScalesRegression(
      n = 50L,
      beta_std = c(0.4, 0.3),
      r_squared = 0.30,
      iv_cormatrix = iv_corr,
      iv_means = c(3, 3.5),
      iv_sds = c(1, 1),
      dv_mean = 4,
      dv_sd = 1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5,
      var_names = c("TooFew", "NamesOnly") # length 2 instead of k+1 = 3
    ),
    regexp = "var_names must have length k\\+1"
  )
})


test_that("print.makeScalesRegression produces informative output", {
  set.seed(321)

  iv_corr <- matrix(c(1.0, 0.3, 0.3, 1.0), nrow = 2, byrow = TRUE)

  res <- suppressWarnings(
    makeScalesRegression(
      n = 40L,
      beta_std = c(0.4, 0.3),
      r_squared = 0.35,
      iv_cormatrix = iv_corr,
      iv_means = c(3.0, 3.5),
      iv_sds = c(1.0, 0.9),
      dv_mean = 3.8,
      dv_sd = 1.1,
      lowerbound_iv = 1,
      upperbound_iv = 5,
      lowerbound_dv = 1,
      upperbound_dv = 5,
      items_iv = 4,
      items_dv = 4,
      var_names = c("Attitude", "Intention", "Behaviour")
    )
  )

  out <- capture.output(print(res))

  testthat::expect_true(any(grepl("Regression Data Generation Results", out)))
  testthat::expect_true(any(grepl("Target R-squared", out)))
  testthat::expect_true(any(grepl("Achieved R-squared", out)))

  # print() should return the object invisibly
  testthat::expect_invisible(print(res))
})