chore(repo): initialize reproducible research workspace

2026-09-20 05:17:11 +12:00
commit 1e7cc2a71b
36 changed files with 9169 additions and 0 deletions
@@ -0,0 +1,113 @@
+command_args <- commandArgs(trailingOnly = FALSE)
+script_path <- sub("^--file=", "", grep("^--file=", command_args, value = TRUE)[1])
+script_dir <- dirname(normalizePath(script_path, winslash = "/"))
+project_root <- normalizePath(file.path(script_dir, "..", ".."), winslash = "/")
+library_path <- file.path(project_root, ".r-library", "4.6")
+.libPaths(c(library_path, .libPaths()))
+
+results <- list(
+  r_version = R.version.string,
+  library_path = library_path,
+  imports = list(),
+  tests = list()
+)
+
+packages <- c(
+  "survey", "srvyr", "mirt", "lavaan", "semTools", "psych",
+  "data.table", "jsonlite", "arrow", "haven", "readr", "dplyr",
+  "tidyr", "purrr", "stringr", "digest", "renv", "targets", "withr"
+)
+
+for (package in packages) {
+  status <- tryCatch({
+    loadNamespace(package)
+    list(status = "passed", version = as.character(packageVersion(package)))
+  }, error = function(error) {
+    list(status = "failed", detail = conditionMessage(error))
+  })
+  results$imports[[package]] <- status
+}
+
+run_test <- function(name, expression) {
+  results$tests[[name]] <<- tryCatch({
+    detail <- force(expression)
+    list(status = "passed", detail = detail)
+  }, error = function(error) {
+    list(status = "failed", detail = conditionMessage(error))
+  })
+}
+
+run_test("survey_weighted_mean", {
+  frame <- data.frame(
+    value = c(1, 2, 3, 4, 5, 6),
+    strata = c(1, 1, 1, 2, 2, 2),
+    psu = c(1, 2, 3, 4, 5, 6),
+    weight = c(1, 2, 1, 2, 1, 2)
+  )
+  design <- survey::svydesign(~psu, strata = ~strata, weights = ~weight, data = frame)
+  estimate <- unname(coef(survey::svymean(~value, design))[[1]])
+  list(estimate = estimate, finite = is.finite(estimate))
+})
+
+run_test("lavaan_cfa", {
+  set.seed(20260920)
+  latent <- rnorm(180)
+  frame <- data.frame(
+    x1 = 0.8 * latent + rnorm(180, sd = 0.4),
+    x2 = 0.7 * latent + rnorm(180, sd = 0.5),
+    x3 = 0.9 * latent + rnorm(180, sd = 0.3)
+  )
+  fit <- lavaan::cfa("factor =~ x1 + x2 + x3", data = frame)
+  list(converged = lavaan::lavInspect(fit, "converged"))
+})
+
+run_test("mirt_2pl", {
+  set.seed(20260920)
+  sample_size <- 500
+  item_count <- 8
+  theta <- rnorm(sample_size)
+  discrimination <- seq(0.8, 1.5, length.out = item_count)
+  difficulty <- seq(-1.2, 1.2, length.out = item_count)
+  probabilities <- vapply(
+    seq_len(item_count),
+    function(index) plogis(discrimination[index] * (theta - difficulty[index])),
+    numeric(sample_size)
+  )
+  responses <- matrix(
+    rbinom(length(probabilities), 1, as.vector(probabilities)),
+    nrow = sample_size,
+    ncol = item_count
+  )
+  colnames(responses) <- paste0("item", seq_len(ncol(responses)))
+  fit <- mirt::mirt(
+    responses,
+    1,
+    itemtype = "2PL",
+    verbose = FALSE,
+    technical = list(NCYCLES = 1000)
+  )
+  converged <- isTRUE(fit@OptimInfo$converged)
+  if (!converged) stop("mirt 2PL fit did not converge")
+  list(converged = converged, items = ncol(responses), respondents = nrow(responses))
+})
+
+run_test("arrow_parquet", {
+  cache_dir <- file.path(project_root, ".cache", "r-smoke")
+  dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE)
+  path <- file.path(cache_dir, "arrow-smoke.parquet")
+  arrow::write_parquet(data.frame(id = 1:3, value = c("a", "b", "c")), path)
+  restored <- arrow::read_parquet(path)
+  list(rows = nrow(restored), columns = ncol(restored))
+})
+
+output_path <- file.path(script_dir, "r-smoke-test-result.json")
+writeLines(
+  jsonlite::toJSON(results, pretty = TRUE, auto_unbox = TRUE, null = "null"),
+  output_path,
+  useBytes = TRUE
+)
+cat(readLines(output_path, warn = FALSE), sep = "\n")
+
+failed_imports <- names(Filter(function(item) item$status != "passed", results$imports))
+failed_tests <- names(Filter(function(item) item$status != "passed", results$tests))
+quit(status = if (length(failed_imports) || length(failed_tests)) 1L else 0L)