tests/testthat/test-preprocess-and-download.R

In writeAlizer: Generate Predicted Writing Quality Scores

# tests/testthat/test-preprocess-and-download.R

testthat::test_that("registry-driven preprocess works for 3-part RB models (rb_mod2)", {
  withr::local_options(writeAlizer.offline = TRUE) # ensure nothing tries to fetch

  rb_path <- wa_sample_path("sample_rb.csv")
  testthat::skip_if(!nzchar(rb_path)  || !file.exists(rb_path),  "sample_rb.csv not found")
  rb <- writeAlizer::import_rb(rb_path)

  # Make a temp dir and create fake varlists there
  tmp <- withr::local_tempdir()
  withr::local_options(writeAlizer.mock_dir = tmp)

  all_cols <- setdiff(colnames(rb), "ID")
  testthat::skip_if(length(all_cols) < 15, "Not enough columns in sample RB file for this test")

  v1 <- all_cols[1:5]; v2 <- all_cols[6:10]; v3 <- all_cols[11:15]
  saveRDS(v1, file.path(tmp, "rb_mod2a_vars.rds"))
  saveRDS(v2, file.path(tmp, "rb_mod2b_vars.rds"))
  saveRDS(v3, file.path(tmp, "rb_mod2c_vars.rds"))

  out <- writeAlizer:::preprocess("rb_mod2", rb)

  # rb_mod2 currently yields a single split; don't assume 3
  testthat::expect_type(out, "list"); testthat::expect_true(length(out) >= 1 && length(out) <= 3)

  df <- out[[1]]
  testthat::expect_s3_class(df, "data.frame")
  testthat::expect_true("ID" %in% names(df))

  # At least one of the provided varlists should be fully present
  sets <- list(v1, v2, v3)
  covered <- vapply(sets, function(sel) all(sel %in% names(df)), logical(1))
  testthat::expect_true(any(covered))

  # Selected columns (whichever exist) should be numeric
  sel_union <- unique(unlist(sets))
  sel_exist <- intersect(sel_union, names(df))
  testthat::expect_true(all(vapply(df[sel_exist], is.numeric, logical(1))))
})

testthat::test_that("registry-driven preprocess works for 1-part Coh models (coh_mod3narr)", {
  withr::local_options(writeAlizer.offline = TRUE)

  coh_path <- wa_sample_path("sample_coh.csv")
  testthat::skip_if(!nzchar(coh_path) || !file.exists(coh_path), "sample_coh.csv not found")
  coh <- writeAlizer::import_coh(coh_path)

  tmp <- withr::local_tempdir()
  withr::local_options(writeAlizer.mock_dir = tmp)

  all_cols <- setdiff(colnames(coh), "ID")
  testthat::skip_if(length(all_cols) < 6, "Not enough columns in sample Coh file for this test")

  v1 <- all_cols[1:6]
  saveRDS(v1, file.path(tmp, "coh_narr_vars.rds"))

  out <- writeAlizer:::preprocess("coh_mod3narr", coh)

  testthat::expect_type(out, "list"); testthat::expect_length(out, 1)
  df <- out[[1]]
  testthat::expect_s3_class(df, "data.frame")
  testthat::expect_true("ID" %in% names(df))
  testthat::expect_true(all(v1 %in% names(df)))
  testthat::expect_true(all(vapply(df[v1], is.numeric, logical(1))))
})

testthat::test_that("models with no preprocessing preserve behavior", {
  withr::local_options(writeAlizer.offline = TRUE)

  # rb_mod1 -> may be single or multiple; don't hardcode count
  rb_path <- wa_sample_path("sample_rb.csv")
  testthat::skip_if(!nzchar(rb_path)  || !file.exists(rb_path),  "sample_rb.csv not found")
  rb <- writeAlizer::import_rb(rb_path)

  out1 <- writeAlizer:::preprocess("rb_mod1", rb)
  testthat::expect_true(is.list(out1) && length(out1) >= 1)
  for (df in out1) testthat::expect_identical(nrow(df), nrow(rb))

  # gamet_cws1 -> don't hardcode count; ensure split(s) preserve nrow
  gm_path <- wa_sample_path("sample_gamet.csv")
  testthat::skip_if(!nzchar(gm_path) || !file.exists(gm_path), "sample_gamet.csv not found")
  gm <- writeAlizer::import_gamet(gm_path)

  out2 <- writeAlizer:::preprocess("gamet_cws1", gm)
  testthat::expect_true(is.list(out2) && length(out2) >= 1)
  testthat::expect_true(all(vapply(out2, nrow, integer(1)) == nrow(gm)))
})

testthat::test_that("unknown model key produces a clear error", {
  withr::local_options(writeAlizer.offline = TRUE)

  rb_path <- wa_sample_path("sample_rb.csv")
  testthat::skip_if(!nzchar(rb_path)  || !file.exists(rb_path),  "sample_rb.csv not found")
  rb <- writeAlizer::import_rb(rb_path)

  testthat::expect_error(
    writeAlizer::predict_quality("no_such_model", rb),
    regexp = "Unknown model key|No variable lists registered|No model artifacts|canonical"
  )
})

testthat::test_that(".wa_load_fits_list loads trained models by filename (coh_mod3all)", {
  withr::local_options(writeAlizer.offline = TRUE)

  load_fits <- getFromNamespace(".wa_load_fits_list", "writeAlizer")
  parts_for <- getFromNamespace(".wa_parts_for",       "writeAlizer")
  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())

  # Create two tiny .rda files with distinct objects
  src1 <- withr::local_tempfile(fileext = ".rda"); m1 <- 1L; save(m1, file = src1)
  src2 <- withr::local_tempfile(fileext = ".rda"); m2 <- 2L; save(m2, file = src2)

  # Use a mock dir so the loader prefers local copies by basename
  mock_dir <- withr::local_tempdir()
  withr::local_options(writeAlizer.mock_dir = mock_dir)

  # Basenames MUST match the 'file' column below
  file_a <- "coh_mod3exp.rda"
  file_b <- "coh_mod3narr.rda"
  dir.create(mock_dir, recursive = TRUE, showWarnings = FALSE)
  ok1 <- file.copy(src1, file.path(mock_dir, file_a), overwrite = TRUE)
  ok2 <- file.copy(src2, file.path(mock_dir, file_b), overwrite = TRUE)
  testthat::expect_true(ok1 && ok2)

  # Minimal registry rows for "coh_mod3all"
  s1 <- digest::digest(src1, algo = "sha256", file = TRUE)
  s2 <- digest::digest(src2, algo = "sha256", file = TRUE)
  reg <- data.frame(
    kind  = c("rda","rda"),
    model = c("coh_mod3all","coh_mod3all"),
    part  = c("a","b"),
    file  = c(file_a,       file_b),
    url   = c(paste0("file:///", normalizePath(src1, winslash = "/")),
              paste0("file:///", normalizePath(src2, winslash = "/"))),
    sha   = c(s1, s2),
    stringsAsFactors = FALSE
  )

  testthat::local_mocked_bindings(.package = "writeAlizer", .wa_registry = function() reg)

  # Sanity: registry filter returns the two rows we expect
  pr <- parts_for("rda", "coh_mod3all")
  testthat::expect_s3_class(pr, "data.frame")
  testthat::expect_equal(nrow(pr), 2L)
  testthat::expect_setequal(basename(pr$file), c(file_a, file_b))

  fits <- load_fits("coh_mod3all")

  testthat::expect_length(fits, 2)

  nm <- names(fits)
  if (!is.null(nm)) {
    testthat::expect_setequal(nm, c("coh_mod3exp", "coh_mod3narr"))
  }

  vals <- unname(fits)
  testthat::expect_true(all(c(m1, m2) %in% unlist(vals)))
})