114 lines
3.7 KiB
R
114 lines
3.7 KiB
R
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)
|