tests/testthat/test-views.R

In shard: Deterministic, Zero-Copy Parallel Execution for R

# Tests for shard views (block views)

test_that("block views over shared matrices materialize correctly", {
  shard:::view_reset_diagnostics()
  X <- matrix(as.double(1:30), nrow = 5)
  Xsh <- share(X, backing = "mmap")

  expect_true(is_shared_vector(Xsh))
  expect_equal(dim(Xsh), dim(X))

  v <- view_block(Xsh, cols = idx_range(2, 4))
  expect_true(is_view(v))
  expect_true(is_block_view(v))

  info <- view_info(v)
  expect_equal(info$layout, "col_block_contiguous")
  expect_equal(info$slice_dim, c(5L, 3L))
  expect_true(isTRUE(info$base_is_shared))

  Xm <- materialize(v)
  expect_equal(Xm, X[, 2:4, drop = FALSE])
})

test_that("views are serializable and remain usable after unserialize", {
  shard:::view_reset_diagnostics()
  X <- matrix(as.double(1:60), nrow = 6)
  Xsh <- share(X, backing = "mmap")
  v <- view_block(Xsh, cols = idx_range(3, 7))

  raw <- serialize(v, connection = NULL, xdr = FALSE)
  v2 <- unserialize(raw)

  expect_true(is_block_view(v2))
  expect_equal(materialize(v2), X[, 3:7, drop = FALSE])
})

test_that("block views reject non-range selectors; view() auto-selects gather", {
  shard:::view_reset_diagnostics()
  X <- matrix(as.double(1:20), nrow = 4)
  Xsh <- share(X, backing = "mmap")

  expect_error(view_block(Xsh, cols = 1:3))

  v1 <- view(Xsh, cols = 1:3, type = "auto")
  expect_true(is_view(v1))
  expect_false(is_block_view(v1))
  expect_true(inherits(v1, "shard_view_gather"))
  expect_equal(materialize(v1), X[, 1:3, drop = FALSE])

  v2 <- view(Xsh, cols = 1:3, type = "gather")
  expect_true(inherits(v2, "shard_view_gather"))
})

test_that("view_col_sums runs without materializing views", {
  shard:::view_reset_diagnostics()

  X <- matrix(rnorm(1000), nrow = 50)
  colnames(X) <- paste0("c", seq_len(ncol(X)))
  Xsh <- share(X, backing = "mmap")

  v <- view_block(Xsh, cols = idx_range(3, 12))
  sums <- shard:::view_col_sums(v)

  expect_equal(unname(sums), unname(colSums(X[, 3:12, drop = FALSE])))
  expect_equal(names(sums), colnames(X)[3:12])

  vd <- view_diagnostics()
  expect_equal(vd$materialized, 0L)
  expect_equal(vd$materialized_bytes, 0)
})

test_that("view_xTy uses BLAS path without materializing views", {
  shard:::view_reset_diagnostics()

  X <- matrix(rnorm(2000), nrow = 100)
  Y <- matrix(rnorm(3000), nrow = 100)
  colnames(X) <- paste0("x", seq_len(ncol(X)))
  colnames(Y) <- paste0("y", seq_len(ncol(Y)))

  Xsh <- share(X, backing = "mmap")
  Ysh <- share(Y, backing = "mmap")

  vY <- view_block(Ysh, cols = idx_range(4, 11))
  out <- shard:::view_xTy(Xsh, vY)

  expect_equal(out, crossprod(X, Y[, 4:11, drop = FALSE]))
  expect_equal(rownames(out), colnames(X))
  expect_equal(colnames(out), colnames(Y)[4:11])

  vd <- view_diagnostics()
  expect_equal(vd$materialized, 0L)
  expect_equal(vd$materialized_bytes, 0)
})

test_that("view_crossprod consumes two views without materializing", {
  shard:::view_reset_diagnostics()

  X <- matrix(rnorm(1500), nrow = 100)
  Y <- matrix(rnorm(2200), nrow = 100)
  colnames(X) <- paste0("x", seq_len(ncol(X)))
  colnames(Y) <- paste0("y", seq_len(ncol(Y)))

  Xsh <- share(X, backing = "mmap")
  Ysh <- share(Y, backing = "mmap")

  vX <- view_block(Xsh, cols = idx_range(2, 9))
  vY <- view_block(Ysh, cols = idx_range(5, 11))

  out <- shard:::view_crossprod(vX, vY)

  expect_equal(out, crossprod(X[, 2:9, drop = FALSE], Y[, 5:11, drop = FALSE]))
  expect_equal(rownames(out), colnames(X)[2:9])
  expect_equal(colnames(out), colnames(Y)[5:11])

  vd <- view_diagnostics()
  expect_equal(vd$materialized, 0L)
  expect_equal(vd$materialized_bytes, 0)
})