wickra/bindings/r/tests/testthat/test-golden.R

# Golden-fixture parity: replay the shared testdata/golden input series through
# the R FFI and assert every value matches the Rust reference output. Where the
# archetype test only checks finiteness, this pins exact values, catching wiring
# bugs (swapped params, wrong multi-output field). Fixtures are generated by
# `cargo run -p wickra-examples --bin gen_golden`.
#
# The fixtures live at the repository root (testdata/golden) and are present
# during the monorepo test run, but they are NOT bundled into the standalone R
# package. A packaged check (r-universe / CRAN) therefore cannot find them, so
# these tests skip there; the parity is already enforced by the repository CI.

find_golden_dir <- 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 <- find_golden_dir()

skip_if_no_golden <- function() {
  skip_if(is.null(golden_dir), "golden fixtures not bundled with the package")
}

read_golden <- function(name) {
  read.csv(file.path(golden_dir, paste0(name, ".csv")),
           colClasses = "character", check.names = FALSE)
}

read_golden_input <- function() read.csv(file.path(golden_dir, "input.csv"))

gcell <- function(s) if (identical(s, "nan")) NA_real_ else as.numeric(s)

expect_close <- function(got, want, row, field) {
  if (is.na(want)) {
    expect_true(is.na(got), info = paste("row", row, field, "expected warmup/NA"))
  } else {
    tol <- 1e-6 * max(1, abs(want))
    expect_lte(abs(got - want), tol, label = paste("row", row, field, "got", got, "want", want))
  }
}

test_that("scalar indicators match golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  specs <- list(c("sma", 14), c("ema", 14), c("rsi", 14))
  for (spec in specs) {
    name <- spec[[1]]
    ind <- switch(name, sma = Sma(14), ema = Ema(14), rsi = Rsi(14))
    exp <- read_golden(name)
    for (i in seq_len(nrow(golden_input))) {
      got <- update(ind, golden_input$close[i])
      expect_close(got, gcell(exp[i, 1]), i, name)
    }
  }
})

test_that("candle Atr matches golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  atr <- Atr(14)
  exp <- read_golden("atr")
  for (i in seq_len(nrow(golden_input))) {
    got <- update(atr, golden_input$open[i], golden_input$high[i], golden_input$low[i],
                  golden_input$close[i], golden_input$volume[i], i - 1)
    expect_close(got, gcell(exp[i, 1]), i, "atr")
  }
})

test_that("pairwise Beta matches golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  beta <- Beta(20)
  exp <- read_golden("beta")
  for (i in seq_len(nrow(golden_input))) {
    # generator fed (close, open)
    got <- update(beta, golden_input$close[i], golden_input$open[i])
    expect_close(got, gcell(exp[i, 1]), i, "beta")
  }
})

test_that("multi-output MACD matches golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  macd <- MacdIndicator(12, 26, 9)
  exp <- read_golden("macd")
  for (i in seq_len(nrow(golden_input))) {
    out <- update(macd, golden_input$close[i])
    if (identical(exp[i, "macd"], "nan")) {
      expect_true(all(is.na(out)), info = paste("row", i, "macd warmup"))
    } else {
      expect_close(out[["macd"]], gcell(exp[i, "macd"]), i, "macd.macd")
      expect_close(out[["signal"]], gcell(exp[i, "signal"]), i, "macd.signal")
      expect_close(out[["histogram"]], gcell(exp[i, "histogram"]), i, "macd.histogram")
    }
  }
})

test_that("multi-output ADX matches golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  adx <- Adx(14)
  exp <- read_golden("adx")
  for (i in seq_len(nrow(golden_input))) {
    out <- update(adx, golden_input$open[i], golden_input$high[i], golden_input$low[i],
                  golden_input$close[i], golden_input$volume[i], i - 1)
    if (identical(exp[i, "plus_di"], "nan")) {
      expect_true(all(is.na(out)), info = paste("row", i, "adx warmup"))
    } else {
      expect_close(out[["plus_di"]], gcell(exp[i, "plus_di"]), i, "adx.plus_di")
      expect_close(out[["minus_di"]], gcell(exp[i, "minus_di"]), i, "adx.minus_di")
      expect_close(out[["adx"]], gcell(exp[i, "adx"]), i, "adx.adx")
    }
  }
})

# The four de-duplicated indicators, pinned against the Rust reference.

test_that("de-duplicated candle indicators match golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  specs <- list(
    list("ad_oscillator", AdOscillator()),
    list("intraday_intensity", IntradayIntensity()),
    list("awesome_oscillator_histogram", AwesomeOscillatorHistogram(5, 34, 1))
  )
  for (spec in specs) {
    name <- spec[[1]]
    ind <- spec[[2]]
    exp <- read_golden(name)
    for (i in seq_len(nrow(golden_input))) {
      got <- update(ind, golden_input$open[i], golden_input$high[i], golden_input$low[i],
                    golden_input$close[i], golden_input$volume[i], i - 1)
      expect_close(got, gcell(exp[i, 1]), i, name)
    }
  }
})

test_that("AverageDrawdown matches golden", {
  skip_if_no_golden()
  golden_input <- read_golden_input()
  avg <- AverageDrawdown(20)
  exp <- read_golden("average_drawdown")
  for (i in seq_len(nrow(golden_input))) {
    # generator fed the close column as the equity-curve sample.
    got <- update(avg, golden_input$close[i])
    expect_close(got, gcell(exp[i, 1]), i, "average_drawdown")
  }
})