tests/testthat/test-edge-cases.R

In delarr: Lazy Delayed Arrays with Fused Execution

# tests/testthat/test-edge-cases.R
# Edge case tests for indices, broadcasting, and chunk boundaries

# --- Negative Index Tests (TEST-03) ---

test_that("negative indices drop first row correctly", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[-1, ])
  expect_equal(result, mat[-1, ])
  expect_equal(dim(result), c(3, 5))
})

test_that("negative indices drop last row correctly", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[-nrow(x), ])
  expect_equal(result, mat[-nrow(mat), ])
  expect_equal(dim(result), c(3, 5))
})

test_that("negative indices drop first column correctly", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[, -1])
  expect_equal(result, mat[, -1])
  expect_equal(dim(result), c(4, 4))
})

test_that("negative indices drop last column correctly", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[, -ncol(x)])
  expect_equal(result, mat[, -ncol(mat)])
  expect_equal(dim(result), c(4, 4))
})

test_that("negative indices drop multiple rows", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[-c(1, 3), ])
  expect_equal(result, mat[-c(1, 3), ])
  expect_equal(dim(result), c(2, 5))
})

test_that("negative indices drop multiple columns", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[, -c(2, 4)])
  expect_equal(result, mat[, -c(2, 4)])
  expect_equal(dim(result), c(4, 3))
})

test_that("negative indices drop all but one row", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  drop_rows <- seq_len(nrow(mat) - 1)
  result <- collect(x[-drop_rows, ])
  expect_equal(result, mat[-drop_rows, , drop = FALSE])
  expect_equal(dim(result), c(1, 5))
})

test_that("negative indices work with both row and column simultaneously", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- collect(x[-1, -ncol(x)])
  expect_equal(result, mat[-1, -ncol(mat)])
  expect_equal(dim(result), c(3, 4))
})

test_that("negative indices combined with lazy operations", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)

  result <- x[-1, ] |> d_map(~ .x * 2) |> collect()
  expect_equal(result, mat[-1, ] * 2)
})

test_that("logical indices containing NA fail clearly", {
  mat <- matrix(1:20, 4, 5)
  x <- delarr(mat)
  expect_error(collect(x[c(TRUE, NA, FALSE, FALSE), ]), "Logical index contains NA")
})

# --- Chunk Size Boundary Tests (TEST-05) ---

test_that("chunk_size=1 produces correct results", {
  mat <- matrix(1:30, 5, 6)
  x <- delarr(mat)

  result <- collect(x, chunk_size = 1L)
  expect_equal(result, mat)
})

test_that("chunk_size equal to ncol produces correct results", {
  mat <- matrix(1:30, 5, 6)
  x <- delarr(mat)

  result <- collect(x, chunk_size = ncol(mat))
  expect_equal(result, mat)
})

test_that("chunk_size larger than ncol produces correct results", {
  mat <- matrix(1:30, 5, 6)
  x <- delarr(mat)

  result <- collect(x, chunk_size = ncol(mat) * 2L)
  expect_equal(result, mat)
})

test_that("chunk_size that evenly divides ncol produces correct results", {
  mat <- matrix(1:30, 5, 6)  # 6 cols
  x <- delarr(mat)

  result <- collect(x, chunk_size = 2L)  # 6 / 2 = 3 chunks
  expect_equal(result, mat)

  result <- collect(x, chunk_size = 3L)  # 6 / 3 = 2 chunks
  expect_equal(result, mat)
})

test_that("chunk_size that doesn't evenly divide ncol produces correct results", {
  mat <- matrix(1:35, 5, 7)  # 7 cols
  x <- delarr(mat)

  result <- collect(x, chunk_size = 2L)  # 4 chunks (2+2+2+1)
  expect_equal(result, mat)

  result <- collect(x, chunk_size = 3L)  # 3 chunks (3+3+1)
  expect_equal(result, mat)

  result <- collect(x, chunk_size = 4L)  # 2 chunks (4+3)
  expect_equal(result, mat)
})

test_that("different chunk sizes produce identical reduction results", {
  set.seed(42)
  mat <- matrix(runif(100), 10, 10)
  x <- delarr(mat)

  # Row reductions with different chunk sizes
  r1 <- collect(d_reduce(x, sum, "rows"), chunk_size = 1L)
  r2 <- collect(d_reduce(x, sum, "rows"), chunk_size = 3L)
  r3 <- collect(d_reduce(x, sum, "rows"), chunk_size = 5L)
  r4 <- collect(d_reduce(x, sum, "rows"), chunk_size = 10L)
  r5 <- collect(d_reduce(x, sum, "rows"), chunk_size = 100L)

  expect_equal(r1, r2)
  expect_equal(r2, r3)
  expect_equal(r3, r4)
  expect_equal(r4, r5)
  expect_equal(r1, rowSums(mat))
})

test_that("chunk boundaries don't affect d_map results", {
  mat <- matrix(1:30, 5, 6)
  x <- delarr(mat)

  result_1 <- x |> d_map(~ .x^2) |> collect(chunk_size = 1L)
  result_2 <- x |> d_map(~ .x^2) |> collect(chunk_size = 2L)
  result_3 <- x |> d_map(~ .x^2) |> collect(chunk_size = 3L)
  result_6 <- x |> d_map(~ .x^2) |> collect(chunk_size = 6L)

  expect_equal(result_1, mat^2)
  expect_equal(result_2, mat^2)
  expect_equal(result_3, mat^2)
  expect_equal(result_6, mat^2)
})

test_that("chunk boundaries don't affect binary operations", {
  mat1 <- matrix(1:30, 5, 6)
  mat2 <- matrix(31:60, 5, 6)
  x <- delarr(mat1)
  y <- delarr(mat2)

  result_1 <- collect(x + y, chunk_size = 1L)
  result_2 <- collect(x + y, chunk_size = 2L)
  result_6 <- collect(x + y, chunk_size = 6L)

  expect_equal(result_1, mat1 + mat2)
  expect_equal(result_2, mat1 + mat2)
  expect_equal(result_6, mat1 + mat2)
})

# --- Broadcasting Edge Case Tests (TEST-04) ---

test_that("broadcasting with vector matching nrow works", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)
  row_vec <- 1:3

  result <- collect(x + row_vec)
  expected <- sweep(mat, 1L, row_vec, "+")
  expect_equal(result, expected)
})

test_that("broadcasting with vector matching ncol works", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)
  col_vec <- 1:4

  result <- collect(x + col_vec)
  expected <- sweep(mat, 2L, col_vec, "+")
  expect_equal(result, expected)
})

test_that("broadcasting rejects non-conformable vectors", {
  mat <- matrix(1:12, 3, 4)  # 3 rows, 4 cols
  x <- delarr(mat)
  bad_vec <- 1:5  # Neither 3 nor 4

  expect_error(collect(x + bad_vec), "Non-conformable")
})

test_that("broadcasting with scalar works", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)

  expect_equal(collect(x + 10), mat + 10)
  expect_equal(collect(x * 2), mat * 2)
  expect_equal(collect(x - 1), mat - 1)
})

test_that("broadcasting handles NaN correctly", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)

  result <- collect(x + NaN)
  expect_true(all(is.nan(result)))
})

test_that("broadcasting handles Inf correctly", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)

  result <- collect(x + Inf)
  expect_true(all(is.infinite(result)))
  expect_true(all(result > 0))

  result_neg <- collect(x + (-Inf))
  expect_true(all(is.infinite(result_neg)))
  expect_true(all(result_neg < 0))
})

test_that("broadcasting with matrix of same dimensions works", {
  mat1 <- matrix(1:12, 3, 4)
  mat2 <- matrix(13:24, 3, 4)
  x <- delarr(mat1)

  result <- collect(x + mat2)
  expect_equal(result, mat1 + mat2)
})

test_that("broadcasting preserves non-commutative semantics for row and column vectors", {
  mat <- matrix(as.double(1:12), 3, 4)
  x <- delarr(mat)
  row_vec <- c(10, 20, 30)
  col_vec <- c(2, 4, 8, 16)

  expect_equal(collect(x - row_vec, chunk_size = 2L), sweep(mat, 1L, row_vec, "-"))
  expect_equal(
    collect(row_vec - x, chunk_size = 2L),
    matrix(row_vec, nrow(mat), ncol(mat)) - mat
  )

  expect_equal(collect(x / col_vec, chunk_size = 2L), sweep(mat, 2L, col_vec, "/"))
  expect_equal(
    collect(col_vec / x, chunk_size = 2L),
    matrix(col_vec, nrow(mat), ncol(mat), byrow = TRUE) / mat
  )

  expect_identical(collect(x > col_vec, chunk_size = 2L), sweep(mat, 2L, col_vec, ">"))
  expect_identical(
    collect(row_vec <= x, chunk_size = 2L),
    matrix(row_vec, nrow(mat), ncol(mat)) <= mat
  )
})

test_that("square-matrix bare vector broadcast is row-aligned and warns once", {
  sq <- matrix(as.double(1:9), 3, 3)
  v <- c(10, 20, 30)
  x <- delarr(sq)

  # The warning is emitted at construction (the `+`), not at collect().
  expect_warning(x + v, "Ambiguous broadcast")

  result <- collect(suppressWarnings(x + v), chunk_size = 2L)
  expect_equal(result, sweep(sq, 1L, v, "+"))
  expect_false(isTRUE(all.equal(result, sweep(sq, 2L, v, "+"))))
})

test_that("square-matrix left-hand vector broadcast is row-aligned and warns", {
  sq <- matrix(as.double(1:9), 3, 3)
  v <- c(10, 20, 30)

  expect_warning(v - delarr(sq), "Ambiguous broadcast")
  result <- collect(suppressWarnings(v - delarr(sq)), chunk_size = 2L)
  expect_equal(result, matrix(v, 3, 3) - sq)
})

test_that("square-matrix column alignment via explicit matrix works without warning", {
  sq <- matrix(as.double(1:9), 3, 3)
  v <- c(10, 20, 30)
  rhs <- matrix(v, 3, 3, byrow = TRUE)

  expect_warning(delarr(sq) + rhs, NA)
  expect_equal(collect(delarr(sq) + rhs), sweep(sq, 2L, v, "+"))
})

test_that("d_map2 warns on ambiguous square broadcast and stays row-aligned", {
  sq <- matrix(as.double(1:9), 3, 3)
  v <- c(10, 20, 30)

  expect_warning(d_map2(delarr(sq), v, ~ .x + .y), "Ambiguous broadcast")
  result <- collect(suppressWarnings(d_map2(delarr(sq), v, ~ .x + .y)))
  expect_equal(result, sweep(sq, 1L, v, "+"))
})

test_that("ambiguous square-broadcast warning is scoped and silenceable", {
  sq <- matrix(as.double(1:9), 3, 3)
  rect <- matrix(as.double(1:12), 3, 4)

  # Scalars on a square matrix are unambiguous: no warning.
  expect_warning(delarr(sq) + 5, NA)

  # Non-square matrices are unambiguous for either orientation: no warning.
  expect_warning(delarr(rect) + 1:3, NA)
  expect_warning(delarr(rect) + 1:4, NA)

  # The warning can be turned off via option.
  old <- options(delarr.warn_ambiguous_broadcast = FALSE)
  on.exit(options(old), add = TRUE)
  expect_warning(delarr(sq) + c(10, 20, 30), NA)
})

test_that("broadcasting rejects matrix of wrong dimensions", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)
  wrong_mat <- matrix(1:6, 2, 3)

  expect_error(collect(x + wrong_mat), "Non-conformable")
})

test_that("broadcasting with delarr RHS of same dimensions works", {
  mat1 <- matrix(1:12, 3, 4)
  mat2 <- matrix(13:24, 3, 4)
  x <- delarr(mat1)
  y <- delarr(mat2)

  result <- collect(x + y)
  expect_equal(result, mat1 + mat2)
})

test_that("broadcasting in d_map2 with scalar works", {
  mat <- matrix(1:12, 3, 4)
  x <- delarr(mat)

  result <- collect(d_map2(x, 2, `*`))
  expect_equal(result, mat * 2)
})