tests/testthat/test-item_restscore.R

In easyRasch2: Psychometric Analysis with Rasch Measurement Theory

test_that("RMitemRestscore errors when iarm is not installed", {
  # This test is only meaningful when iarm is NOT installed.
  skip_if(
    requireNamespace("iarm", quietly = TRUE),
    "iarm is installed; skipping missing-package error path test"
  )
  df <- as.data.frame(matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5))
  expect_error(RMitemRestscore(df), regexp = "iarm")
})

test_that("RMitemRestscore errors when data does not start at 0", {
  skip_if_not_installed("iarm")
  df <- as.data.frame(matrix(sample(1:3, 200, replace = TRUE), nrow = 40, ncol = 5))
  expect_error(RMitemRestscore(df), regexp = "scored starting at 0")
})

test_that("RMitemRestscore errors when data is all NA", {
  skip_if_not_installed("iarm")
  df <- as.data.frame(matrix(NA_integer_, nrow = 10, ncol = 4))
  expect_error(RMitemRestscore(df), regexp = "no non-missing|No complete|non-missing")
})

test_that("RMitemRestscore errors when no complete cases", {
  skip_if_not_installed("iarm")
  # Create data where every row has at least one NA
  df <- as.data.frame(matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5))
  # Make all rows have at least one NA by cycling through columns
  df[cbind(seq_len(nrow(df)), ((seq_len(nrow(df)) - 1L) %% ncol(df)) + 1L)] <- NA
  expect_error(RMitemRestscore(df), regexp = "No complete cases")
})

test_that("RMitemRestscore output = 'dataframe' returns correct structure (dichotomous)", {
  skip_if_not_installed("iarm")
  skip_if_not_installed("eRm")
  set.seed(42)
  df <- as.data.frame(
    matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5)
  )
  colnames(df) <- paste0("Item", 1:5)

  result <- RMitemRestscore(df, output = "dataframe")

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 5L)
  expected_cols <- c(
    "Item", "Observed", "Expected", "Difference",
    "p_adjusted", "Flagged", "Relative_location"
  )
  expect_equal(names(result), expected_cols)
  expect_true(all(result$Flagged %in% c("overfit", "underfit", "")))
  # overfit <=> observed above expected, underfit <=> below (when flagged)
  flg <- result$Flagged != ""
  expect_true(all((result$Difference[flg] > 0) == (result$Flagged[flg] == "overfit")))
  expect_equal(result$Item, colnames(df))
  # Signed difference equals Observed - Expected (dataframe output is
  # unrounded; rounding happens only in the kable display)
  expect_equal(result$Difference, result$Observed - result$Expected)
})

test_that("RMitemRestscore p_adj = 'none' returns numeric raw p-values without a coercion warning", {
  skip_if_not_installed("iarm")
  skip_if_not_installed("eRm")
  set.seed(42)
  df <- as.data.frame(
    matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5)
  )
  colnames(df) <- paste0("Item", 1:5)

  # Regression: with p.adj = "none" iarm drops the "padj.*" column, so the
  # p-value must be read from "pvalue" by name, not from fixed position 5
  # (which becomes the significance-stars column -> NA + coercion warning).
  expect_no_warning(
    result <- RMitemRestscore(df, output = "dataframe", p_adj = "none")
  )
  expect_type(result$p_adjusted, "double")
  expect_equal(sum(is.na(result$p_adjusted)), 0L)
})

test_that("RMitemRestscore output = 'kable' returns knitr_kable object", {
  skip_if_not_installed("iarm")
  skip_if_not_installed("eRm")
  set.seed(42)
  df <- as.data.frame(
    matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5)
  )
  colnames(df) <- paste0("Item", 1:5)

  result <- RMitemRestscore(df, output = "kable")
  expect_s3_class(result, "knitr_kable")
})

test_that("RMitemRestscore sort = 'diff' sorts by absolute Difference descending", {
  skip_if_not_installed("iarm")
  skip_if_not_installed("eRm")
  set.seed(42)
  df <- as.data.frame(
    matrix(sample(0:1, 200, replace = TRUE), nrow = 40, ncol = 5)
  )
  colnames(df) <- paste0("Item", 1:5)

  result_sorted   <- RMitemRestscore(df, output = "dataframe", sort = "diff")
  result_unsorted <- RMitemRestscore(df, output = "dataframe")

  expect_true(
    all(diff(abs(result_sorted$Difference)) <= 0),
    info = "Rows should be in descending order of |Difference|"
  )
  # Unsorted should contain the same rows, just in a different order
  expect_setequal(result_sorted$Item, result_unsorted$Item)
})

test_that("RMitemRestscore drops all-NA respondents instead of erroring", {
  skip_if_not_installed("iarm")
  set.seed(42)
  df <- as.data.frame(matrix(sample(0:2, 60 * 6, replace = TRUE), nrow = 60))
  colnames(df) <- paste0("i", 1:6)
  df[3, ] <- NA

  expect_message(k <- RMitemRestscore(df), "no responses dropped")
  expect_match(paste(as.character(k), collapse = "\n"), "of 60 respondents")
})