tests/testthat/test-onnx-ops.R

In ggmlR: 'GGML' Tensor Operations for Machine Learning

# Tests for ONNX ops: Sin, Cos, Tile, Pow, Erf, Clip, Cast, Constant,
# ConvTranspose, GroupNorm, RMSNorm, Resize(sizes)

run_onnx <- function(path, inputs, device = "cpu") {
  m <- onnx_load(path, device = device)
  res <- onnx_run(m, inputs)
  res[[1]]
}

# ── Sin ────────────────────────────────────────────────────────

test_that("ONNX Sin works", {
  path <- .onnx_make_unary("Sin", c(4L))
  x <- c(0, pi/6, pi/2, pi)
  result <- run_onnx(path, list(X = x))
  expect_equal(as.numeric(result), sin(x), tolerance = 1e-4)
})

# ── Cos ────────────────────────────────────────────────────────

test_that("ONNX Cos works", {
  path <- .onnx_make_unary("Cos", c(4L))
  x <- c(0, pi/3, pi/2, pi)
  result <- run_onnx(path, list(X = x))
  expect_equal(as.numeric(result), cos(x), tolerance = 1e-4)
})

# ── Sin + Cos positional encoding pattern ──────────────────────

test_that("ONNX Sin+Cos chain for positional encoding works", {
  # Pattern: X → Sin → S, X → Cos → C, Concat(S, C) → Y
  inp  <- .onnx_value_info("X", 1L, c(4L))
  outp <- .onnx_value_info("Y", 1L, c(8L))
  sin_node    <- .onnx_node("Sin", "X", "S")
  cos_node    <- .onnx_node("Cos", "X", "C")
  concat_node <- .onnx_node("Concat", c("S", "C"), "Y",
                             attrs = list(.onnx_attr_int("axis", 0L)))
  graph <- .onnx_graph("test", list(sin_node, cos_node, concat_node),
                        list(inp), list(outp))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  x <- c(0, pi/4, pi/2, pi)
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  expect_equal(length(r), 8)
  expect_equal(r[1:4], sin(x), tolerance = 1e-4)
  expect_equal(r[5:8], cos(x), tolerance = 1e-4)
})

# ── Tile ───────────────────────────────────────────────────────

test_that("ONNX Tile repeats 1D tensor", {
  # X[3] tiled 2x → Y[6]
  inp <- .onnx_value_info("X", 1L, c(3L))
  outp <- .onnx_value_info("Y", 1L, c(6L))
  reps_raw <- .int64_bytes(2L)
  reps_t  <- .onnx_tensor("reps", c(1L), 7L, reps_raw)
  reps_vi <- .onnx_value_info("reps", 7L, c(1L))
  node <- .onnx_node("Tile", c("X", "reps"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp, reps_vi), list(outp), list(reps_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  result <- run_onnx(path, list(X = c(1, 2, 3)))
  expect_equal(as.numeric(result), c(1, 2, 3, 1, 2, 3), tolerance = 1e-5)
})

test_that("ONNX Tile repeats 2D tensor", {
  # X[2,3] tiled [1,2] → Y[2,6]
  inp <- .onnx_value_info("X", 1L, c(2L, 3L))
  outp <- .onnx_value_info("Y", 1L, c(2L, 6L))
  reps_raw <- c(.int64_bytes(1L), .int64_bytes(2L))
  reps_t  <- .onnx_tensor("reps", c(2L), 7L, reps_raw)
  reps_vi <- .onnx_value_info("reps", 7L, c(2L))
  node <- .onnx_node("Tile", c("X", "reps"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp, reps_vi), list(outp), list(reps_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  x <- c(1, 2, 3, 4, 5, 6)  # [[1,2,3],[4,5,6]]
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  expect_equal(length(r), 12)
  # First row repeated: [1,2,3,1,2,3], second: [4,5,6,4,5,6]
  expect_equal(sum(r), 2 * sum(x), tolerance = 1e-3)
})

# ── Pow ────────────────────────────────────────────────────────

test_that("ONNX Pow with scalar exponent works", {
  # X^2: [1,2,3,4] → [1,4,9,16]
  inp_x <- .onnx_value_info("X", 1L, c(4L))
  inp_e <- .onnx_value_info("E", 1L, c(1L))
  outp  <- .onnx_value_info("Y", 1L, c(4L))
  node  <- .onnx_node("Pow", c("X", "E"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp_x, inp_e), list(outp))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  result <- run_onnx(path, list(X = c(1, 2, 3, 4), E = c(2)))
  expect_equal(as.numeric(result), c(1, 4, 9, 16), tolerance = 1e-2)
})

test_that("ONNX Pow with 0.5 exponent is sqrt", {
  inp_x <- .onnx_value_info("X", 1L, c(4L))
  inp_e <- .onnx_value_info("E", 1L, c(1L))
  outp  <- .onnx_value_info("Y", 1L, c(4L))
  node  <- .onnx_node("Pow", c("X", "E"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp_x, inp_e), list(outp))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  result <- run_onnx(path, list(X = c(1, 4, 9, 16), E = c(0.5)))
  expect_equal(as.numeric(result), c(1, 2, 3, 4), tolerance = 1e-3)
})

# ── Erf ────────────────────────────────────────────────────────

test_that("ONNX Erf approximation is reasonable", {
  path <- .onnx_make_unary("Erf", c(4L))
  x <- c(-1, 0, 0.5, 1)
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  # erf(0) = 0
  expect_equal(r[2], 0, tolerance = 1e-3)
  # tanh approximation: erf(1) ≈ 0.68 (true 0.84), erf(0.5) ≈ 0.38 (true 0.52)
  # Wide tolerance — what matters is sign and monotonicity, not exact value.
  # The approximation is tuned for GELU subgraph, not standalone erf accuracy.
  expect_true(r[1] < -0.5 && r[1] > -0.95)
  expect_true(r[4] > 0.5 && r[4] < 0.95)
  # erf is odd: erf(-x) = -erf(x)
  expect_equal(r[1], -r[4], tolerance = 0.02)
  # erf(0.5) approx ≈ 0.38
  expect_true(r[3] > 0.2 && r[3] < 0.6)
})

test_that("ONNX Erf in GELU subgraph pattern works", {
  # GELU(x) = 0.5 * x * (1 + erf(x / sqrt(2)))
  # Build: X → scale(1/sqrt2) → Erf → add(1) → mul(X) → scale(0.5)
  inp  <- .onnx_value_info("X", 1L, c(4L))
  outp <- .onnx_value_info("Y", 1L, c(4L))

  # scale(1/sqrt(2)) via Div by sqrt(2) constant
  sqrt2_raw <- .float_bytes(1.4142135)
  sqrt2_t   <- .onnx_tensor("sqrt2", c(1L), 1L, sqrt2_raw)
  sqrt2_vi  <- .onnx_value_info("sqrt2", 1L, c(1L))

  half_raw <- .float_bytes(0.5)
  half_t   <- .onnx_tensor("half", c(1L), 1L, half_raw)
  half_vi  <- .onnx_value_info("half", 1L, c(1L))

  one_raw <- .float_bytes(1.0)
  one_t   <- .onnx_tensor("one", c(1L), 1L, one_raw)
  one_vi  <- .onnx_value_info("one", 1L, c(1L))

  n1 <- .onnx_node("Div", c("X", "sqrt2"), "div_out")
  n2 <- .onnx_node("Erf", "div_out", "erf_out")
  n3 <- .onnx_node("Add", c("erf_out", "one"), "add_out")
  n4 <- .onnx_node("Mul", c("X", "add_out"), "mul_out")
  n5 <- .onnx_node("Mul", c("mul_out", "half"), "Y")

  graph <- .onnx_graph("test", list(n1, n2, n3, n4, n5),
                        list(inp, sqrt2_vi, half_vi, one_vi),
                        list(outp),
                        list(sqrt2_t, half_t, one_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  x <- c(-1, 0, 0.5, 1)
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  # gelu(0) = 0
  expect_equal(r[2], 0, tolerance = 1e-3)
  # gelu(-1) ≈ -0.159 (true), approx ≈ -0.24
  expect_true(r[1] > -0.3 && r[1] < -0.05)
  # gelu(1) ≈ 0.841 (true), approx ≈ 0.76
  expect_true(r[4] > 0.65 && r[4] < 0.95)
})

# ── Clip ───────────────────────────────────────────────────────

test_that("ONNX Clip with attr min/max works", {
  attrs <- list(.onnx_attr_float("min", -1.0),
                .onnx_attr_float("max", 1.0))
  path <- .onnx_make_unary("Clip", c(4L), attrs = attrs)
  x <- c(-5, -0.5, 0.5, 5)
  result <- run_onnx(path, list(X = x))
  expect_equal(as.numeric(result), c(-1, -0.5, 0.5, 1), tolerance = 1e-5)
})

test_that("ONNX Clip with only min works", {
  attrs <- list(.onnx_attr_float("min", 0.0))
  path <- .onnx_make_unary("Clip", c(4L), attrs = attrs)
  x <- c(-2, -1, 0, 3)
  result <- run_onnx(path, list(X = x))
  # Should clip to [0, +inf] — same as Relu
  expect_equal(as.numeric(result), pmax(x, 0), tolerance = 1e-5)
})

# ── Cast (pass-through for f32) ────────────────────────────────

test_that("ONNX Cast is pass-through", {
  path <- .onnx_make_unary("Cast", c(4L))
  x <- c(1.5, 2.5, 3.5, 4.5)
  result <- run_onnx(path, list(X = x))
  expect_equal(as.numeric(result), x, tolerance = 1e-5)
})

# ── Constant (scalar via value_float attr) ─────────────────────

test_that("ONNX Constant scalar adds correctly", {
  # Constant(value_float=7) → Add(X, const) → Y
  inp  <- .onnx_value_info("X", 1L, c(4L))
  outp <- .onnx_value_info("Y", 1L, c(4L))
  const_node <- .onnx_node("Constant", character(0), "C",
                            attrs = list(.onnx_attr_float("value_float", 7.0)))
  add_node <- .onnx_node("Add", c("X", "C"), "Y")
  graph <- .onnx_graph("test", list(const_node, add_node),
                        list(inp), list(outp))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  result <- run_onnx(path, list(X = c(1, 2, 3, 4)))
  expect_equal(as.numeric(result), c(8, 9, 10, 11), tolerance = 1e-3)
})

test_that("ONNX Constant tensor works", {
  # Constant(value=TensorProto[4]{10,20,30,40}) → Add(X, const) → Y
  inp  <- .onnx_value_info("X", 1L, c(4L))
  outp <- .onnx_value_info("Y", 1L, c(4L))
  t_raw <- unlist(lapply(c(10, 20, 30, 40), .float_bytes))
  const_node <- .onnx_node("Constant", character(0), "C",
                            attrs = list(.onnx_attr_tensor("value", c(4L), 1L, t_raw)))
  add_node <- .onnx_node("Add", c("X", "C"), "Y")
  graph <- .onnx_graph("test", list(const_node, add_node),
                        list(inp), list(outp))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  result <- run_onnx(path, list(X = c(1, 2, 3, 4)))
  expect_equal(as.numeric(result), c(11, 22, 33, 44), tolerance = 1e-3)
})

# ── ConvTranspose 1D ──────────────────────────────────────────

test_that("ONNX ConvTranspose 1D basic works", {
  # X[1,1,3], W[1,1,2], stride=1 → output [1,1,4]
  inp <- .onnx_value_info("X", 1L, c(1L, 1L, 3L))
  outp <- .onnx_value_info("Y", 1L, c(1L, 1L, 4L))
  w_raw <- unlist(lapply(c(1, 1), .float_bytes))
  w_t  <- .onnx_tensor("W", c(1L, 1L, 2L), 1L, w_raw)
  w_vi <- .onnx_value_info("W", 1L, c(1L, 1L, 2L))
  node <- .onnx_node("ConvTranspose", c("X", "W"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp, w_vi), list(outp), list(w_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  # x=[1,2,3], w=[1,1] → conv_transpose_1d = [1, 3, 5, 3]
  result <- run_onnx(path, list(X = c(1, 2, 3)))
  r <- as.numeric(result)
  expect_equal(length(r), 4)
  expect_equal(r[1], 1, tolerance = 1e-3)
  expect_equal(r[4], 3, tolerance = 1e-3)
})

# ── GroupNormalization ─────────────────────────────────────────

test_that("ONNX GroupNormalization works", {
  # X[1,4,2,2] with 2 groups → normalize each group of 2 channels
  inp <- .onnx_value_info("X", 1L, c(1L, 4L, 2L, 2L))
  outp <- .onnx_value_info("Y", 1L, c(1L, 4L, 2L, 2L))
  scale_raw <- unlist(lapply(rep(1.0, 4), .float_bytes))
  bias_raw  <- unlist(lapply(rep(0.0, 4), .float_bytes))
  scale_t  <- .onnx_tensor("scale", c(4L), 1L, scale_raw)
  bias_t   <- .onnx_tensor("bias",  c(4L), 1L, bias_raw)
  scale_vi <- .onnx_value_info("scale", 1L, c(4L))
  bias_vi  <- .onnx_value_info("bias",  1L, c(4L))
  node <- .onnx_node("GroupNormalization",
                      c("X", "scale", "bias"), "Y",
                      attrs = list(.onnx_attr_int("num_groups", 2L)))
  graph <- .onnx_graph("test", list(node),
                        list(inp, scale_vi, bias_vi), list(outp),
                        list(scale_t, bias_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  x <- 1:16
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  expect_equal(length(r), 16)
  # After normalization, each group should have mean ≈ 0
  # Group 1: channels 0-1 (elements 1-8 in ONNX order)
  expect_true(abs(mean(r[1:8])) < 0.1)
})

# ── RMSNormalization ──────────────────────────────────────────

test_that("ONNX RMSNormalization works", {
  path <- .onnx_make_unary("RMSNormalization", c(4L))
  x <- c(1, 2, 3, 4)
  result <- run_onnx(path, list(X = x))
  r <- as.numeric(result)
  # RMS norm: x / sqrt(mean(x^2) + eps)
  rms <- sqrt(mean(x^2) + 1e-5)
  expected <- x / rms
  expect_equal(r, expected, tolerance = 1e-3)
})

# ── Resize with scales (float, not int64 sizes) ───────────────

test_that("ONNX Resize nearest 2x with sizes works", {
  # X[1,1,2,2] → Resize → Y[1,1,4,4] using sizes input
  inp <- .onnx_value_info("X", 1L, c(1L, 1L, 2L, 2L))
  outp <- .onnx_value_info("Y", 1L, c(1L, 1L, 4L, 4L))

  # roi (empty), scales (empty), sizes=[1,1,4,4]
  roi_raw <- raw(0)
  roi_t   <- .onnx_tensor("roi", c(0L), 1L, roi_raw)
  roi_vi  <- .onnx_value_info("roi", 1L, c(0L))

  scales_raw <- raw(0)
  scales_t   <- .onnx_tensor("scales", c(0L), 1L, scales_raw)
  scales_vi  <- .onnx_value_info("scales", 1L, c(0L))

  sizes_raw <- c(.int64_bytes(1L), .int64_bytes(1L),
                 .int64_bytes(4L), .int64_bytes(4L))
  sizes_t   <- .onnx_tensor("sizes", c(4L), 7L, sizes_raw)
  sizes_vi  <- .onnx_value_info("sizes", 7L, c(4L))

  node <- .onnx_node("Resize", c("X", "roi", "scales", "sizes"), "Y")
  graph <- .onnx_graph("test", list(node),
                        list(inp, roi_vi, scales_vi, sizes_vi),
                        list(outp),
                        list(roi_t, scales_t, sizes_t))
  path <- tempfile(fileext = ".onnx")
  writeBin(.onnx_model(graph), path)

  x <- c(1, 2, 3, 4)
  result <- run_onnx(path, list(X = x))
  expect_equal(length(result), 16)
  expect_equal(result[1], 1, tolerance = 1e-5)
  expect_equal(result[16], 4, tolerance = 1e-5)
})