tests/testthat/test-resolve-propagate.R

In vectra: Columnar Query Engine for Larger-than-RAM Data

# --- resolve() tests ---

test_that("resolve() looks up string values via integer FK", {
  df <- data.frame(
    id = c(1L, 2L, 3L, 4L),
    name = c("Alpha", "Beta", "Gamma", "Delta"),
    parent_id = c(NA, 1L, 1L, 2L),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(parent_name = resolve(parent_id, id, name)) |>
    collect()

  expect_equal(result$parent_name, c(NA, "Alpha", "Alpha", "Beta"))
})

test_that("resolve() returns NA for missing FK values", {
  df <- data.frame(
    id = c(1L, 2L, 3L),
    name = c("A", "B", "C"),
    fk = c(2L, 99L, 1L),  # 99 doesn't exist
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(resolved = resolve(fk, id, name)) |>
    collect()

  expect_equal(result$resolved, c("B", NA, "A"))
})

test_that("resolve() returns NA when FK is NA", {
  df <- data.frame(
    id = c(1L, 2L, 3L),
    value = c(10.0, 20.0, 30.0),
    fk = c(NA, 1L, 2L)
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(resolved = resolve(fk, id, value)) |>
    collect()

  expect_equal(result$resolved, c(NA, 10.0, 20.0))
})

test_that("resolve() works with numeric columns", {
  df <- data.frame(
    id = c(1L, 2L, 3L),
    score = c(100.0, 200.0, 300.0),
    ref = c(3L, 1L, 2L)
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(ref_score = resolve(ref, id, score)) |>
    collect()

  expect_equal(result$ref_score, c(300.0, 100.0, 200.0))
})

test_that("resolve() works with string FK and PK", {
  df <- data.frame(
    code = c("A", "B", "C"),
    label = c("Alpha", "Beta", "Gamma"),
    parent_code = c(NA, "A", "B"),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(parent_label = resolve(parent_code, code, label)) |>
    collect()

  expect_equal(result$parent_label, c(NA, "Alpha", "Beta"))
})

# --- propagate() tests ---

test_that("propagate() fills children from parent values", {
  # Tree: 1(root, rank=FAMILY) -> 2(child) -> 3(grandchild)
  df <- data.frame(
    id = c(1L, 2L, 3L),
    parent_id = c(NA, 1L, 2L),
    rank = c("FAMILY", "GENUS", "SPECIES"),
    name = c("Fagaceae", "Quercus", "Quercus robur"),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(family = propagate(
      parent_id, id,
      ifelse(rank == "FAMILY", name, NA)
    )) |>
    collect()

  expect_equal(result$family, c("Fagaceae", "Fagaceae", "Fagaceae"))
})

test_that("propagate() handles disconnected trees", {
  df <- data.frame(
    id = c(1L, 2L, 3L, 4L, 5L),
    parent_id = c(NA, 1L, 2L, NA, 4L),
    rank = c("FAMILY", "GENUS", "SPECIES", "FAMILY", "GENUS"),
    name = c("Fagaceae", "Quercus", "Q. robur", "Rosaceae", "Rosa"),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(family = propagate(
      parent_id, id,
      ifelse(rank == "FAMILY", name, NA)
    )) |>
    collect()

  expect_equal(result$family, c("Fagaceae", "Fagaceae", "Fagaceae",
                                 "Rosaceae", "Rosaceae"))
})

test_that("propagate() returns NA for orphan nodes", {
  # Node 3 has parent 99 which doesn't exist
  df <- data.frame(
    id = c(1L, 2L, 3L),
    parent_id = c(NA, 1L, 99L),
    rank = c("FAMILY", "GENUS", "SPECIES"),
    name = c("Fagaceae", "Quercus", "Unknown"),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(family = propagate(
      parent_id, id,
      ifelse(rank == "FAMILY", name, NA)
    )) |>
    collect()

  expect_equal(result$family, c("Fagaceae", "Fagaceae", NA))
})

test_that("propagate() works with numeric seed values", {
  df <- data.frame(
    id = c(1L, 2L, 3L, 4L),
    parent_id = c(NA, 1L, 2L, 1L),
    is_root = c(TRUE, FALSE, FALSE, FALSE),
    weight = c(42.0, NA, NA, NA)
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(root_weight = propagate(
      parent_id, id,
      ifelse(is_root, weight, NA)
    )) |>
    collect()

  expect_equal(result$root_weight, c(42.0, 42.0, 42.0, 42.0))
})

test_that("propagate() converges for deep trees", {
  # Chain: 1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 8 -> 9 -> 10
  n <- 10L
  df <- data.frame(
    id = seq_len(n),
    parent_id = c(NA, seq_len(n - 1L)),
    rank = c("ROOT", rep("CHILD", n - 1L)),
    name = c("TopValue", paste0("node", 2:n)),
    stringsAsFactors = FALSE
  )
  f <- tempfile(fileext = ".vtr")
  on.exit(unlink(f))
  write_vtr(df, f)

  result <- tbl(f) |>
    mutate(root_name = propagate(
      parent_id, id,
      ifelse(rank == "ROOT", name, NA)
    )) |>
    collect()

  expect_equal(result$root_name, rep("TopValue", n))
})