# Generic golden-fixture parity for the whole 514-indicator catalogue: every # indicator is reconstructed by its constructor, fed the synthetic stream derived # from the shared testdata/golden input (identical to gen_golden's Rust # construction) and checked bit-for-bit against g_.csv. One reflective # runner flattens scalar, multi-output, profile and bar shapes. # # Like test-golden.R, the fixtures live at the repo root and are not bundled into # the standalone package, so packaged checks (r-universe / CRAN) skip; the parity # is enforced by the monorepo CI. Specs are generated by gen_golden_test.py. find_golden_dir_all <- function() { d <- normalizePath(getwd(), winslash = "/", mustWork = FALSE) repeat { g <- file.path(d, "testdata", "golden") if (dir.exists(g)) return(g) parent <- dirname(d) if (identical(parent, d)) return(NULL) d <- parent } } golden_dir_all <- find_golden_dir_all() test_that("all 514 indicators match the Rust golden fixtures", { skip_if(is.null(golden_dir_all), "golden fixtures not bundled with the package") source(test_path("golden_specs.R"), local = TRUE) gcell <- function(s) { if (s == "nan") NA_real_ else if (s == "inf") Inf else if (s == "-inf") -Inf else as.numeric(s) } read_rows <- function(name) { lines <- readLines(file.path(golden_dir_all, paste0(name, ".csv")))[-1] lapply(lines, function(l) { if (nchar(l) == 0) return(numeric(0)) vapply(strsplit(l, ",", fixed = TRUE)[[1]], gcell, numeric(1), USE.NAMES = FALSE) }) } input_rows <- lapply( readLines(file.path(golden_dir_all, "input.csv"))[-1], function(l) as.numeric(strsplit(l, ",", fixed = TRUE)[[1]]) ) deriv_fields <- function(r) { o <- r[1]; h <- r[2]; l <- r[3]; c <- r[4]; v <- r[5] c((c - o) / c * 0.01, c, c - 0.5, c + 1.0, v * 10, v * 0.6, v * 0.4, v * 0.55, v * 0.45, h - c, c - l) } cross_lists <- function(r) { o <- r[1]; c <- r[4]; v <- r[5]; j <- 0:4 list(change = (c - o) + j, volume = v + j * 10, newHigh = as.numeric(j %% 2 == 0), newLow = as.numeric(j %% 3 == 0), aboveMa = as.numeric(j %% 2 == 0), onBuy = as.numeric(j %% 3 == 0)) } ob_lists <- function(r) { c <- r[4]; v <- r[5]; k <- 1:5 list(bp = c - 0.1 * k, bs = v / k, ap = c + 0.1 * k, asz = v * 0.9 / k) } flatten <- function(o, arch, width) { if (arch %in% c("profile_bins")) { if (is.null(o) || length(o) == 0 || all(is.na(o))) return(rep(NA_real_, width)) return(as.numeric(o)) } if (arch == "profile_pricebins") { if (is.list(o)) return(c(o$price_low, o$price_high, as.numeric(o$values))) return(rep(NA_real_, width)) } if (arch %in% c("bars_close", "bars_candle4", "bars_candle5", "footprint")) { if (is.null(o) || length(o) == 0) return(numeric(0)) if (is.matrix(o)) return(as.numeric(t(o))) return(as.numeric(o)) } as.numeric(o) } compute <- function(spec, ind, r, i) { o <- r[1]; h <- r[2]; l <- r[3]; cl <- r[4]; v <- r[5]; ts <- as.integer(i - 1) out <- switch(spec$arch, scalar_f64 = update(ind, cl), multi_f64 = update(ind, cl), pairwise = , multi_pairwise = update(ind, cl, o), scalar_candle = , multi_candle = , profile_bins = , profile_pricebins = update(ind, o, h, l, cl, v, ts), trade = update(ind, cl, v, cl >= o, ts), trademid = update(ind, cl, v, cl >= o, ts, (h + l) / 2), ob = { L <- ob_lists(r); update(ind, L$bp, L$bs, L$ap, L$asz) }, cross = { L <- cross_lists(r) update(ind, L$change, L$volume, L$newHigh, L$newLow, L$aboveMa, L$onBuy, ts) }, deriv = , deriv_multi = { d <- deriv_fields(r) do.call(update, c(list(ind), as.list(d), list(ts))) }, bars_close = update(ind, cl, cl, cl, cl, 1, 0L), bars_candle4 = update(ind, o, h, l, cl, 1, 0L), bars_candle5 = update(ind, o, h, l, cl, v, 0L), footprint = update(ind, cl, v, cl >= o, ts), stop("arch ", spec$arch) ) flatten(out, spec$arch, spec$width) } for (spec in GOLDEN_SPECS) { ind <- do.call(get(spec$canon), as.list(spec$params)) expect_identical(name(ind), spec$name, info = sprintf("%s name()", spec$canon)) exp <- read_rows(paste0("g_", spec$canon)) for (i in seq_along(input_rows)) { got <- compute(spec, ind, input_rows[[i]], i) want <- exp[[i]] expect_equal(length(got), length(want), info = sprintf("%s row %d arity", spec$canon, i)) for (k in seq_along(want)) { w <- want[k]; g <- got[k] if (is.na(w)) { expect_true(is.na(g), info = sprintf("%s row %d col %d: want NA", spec$canon, i, k)) } else if (is.infinite(w)) { expect_true(is.infinite(g) && sign(g) == sign(w), info = sprintf("%s row %d col %d: want %g", spec$canon, i, k, w)) } else { expect_lte(abs(g - w), 1e-6 * max(1, abs(w)), label = sprintf("%s row %d col %d (got %s want %g)", spec$canon, i, k, as.character(g), w)) } } } } })