CRAN test fixes for rvar on R 4.4

NEWS.md

@@ -18,6 +18,8 @@
 * Ensure `rfun()` works with primitive functions (#290) and dots arguments (#291).
 * Provide implementations of `vctrs::vec_proxy_equal()`, `vctrs::vec_proxy_compare()`,
   and `vctrs::vec_proxy_order()`.
+* Minor future-proofing of `cbind(<rvar>)`, `rbind(<rvar>)`, and `chol(<rvar>)`
+  for R 4.4 (#304).
 
 
 # posterior 1.4.1

R/rvar-bind.R

@@ -26,16 +26,18 @@ c.rvar <- function(...) {
 }
 
 #' @export
-rbind.rvar <- function(...) {
-  # not sure why deparse.level is not passed here correctly...
-  deparse.level <- rlang::caller_env()$deparse.level %||% 1
+rbind.rvar <- function(..., deparse.level = 1) {
+  # deparse.level is not correctly passed here by the default rbind
+  # implementation in R < 4.4, so we grab it from the calling environment
+  deparse.level <- rlang::caller_env()$deparse.level %||% deparse.level
   bind_rvars(list(...), as.list(substitute(list(...))[-1]), deparse.level)
 }
 
 #' @export
-cbind.rvar <- function(...) {
-  # not sure why deparse.level is not passed here correctly...
-  deparse.level <- rlang::caller_env()$deparse.level %||% 1
+cbind.rvar <- function(..., deparse.level = 1) {
+  # deparse.level is not correctly passed here by the default cbind
+  # implementation in R < 4.4, so we grab it from the calling environment
+  deparse.level <- rlang::caller_env()$deparse.level %||% deparse.level
   bind_rvars(list(...), as.list(substitute(list(...))[-1]), deparse.level, axis = 2)
 }
 

R/rvar-math.R

@@ -237,6 +237,7 @@ chol.rvar <- function(x, ...) {
 
   # drop dimension names (chol.tensor screws them around)
   names(dim(result)) <- NULL
+  dimnames(result) <- NULL
 
   new_rvar(result, .nchains = nchains(x))
 }

R/rvar-slice.R

@@ -278,15 +278,15 @@ NULL
     index[seq(length(index) + 1, length(dim(.draws)) - 1)] = list(missing_arg())
   }
 
-  x <- inject(
-    new_rvar(.draws[!!!draws_index, !!!index, drop = FALSE], .nchains = nchains(x))
-  )
+  .draws <- inject(.draws[!!!draws_index, !!!index, drop = FALSE])
 
   if (!is_missing(draws_index[[1]])) {
     # if we subsetted draws, replace draw ids with sequential ids
-    rownames(draws_of(x)) <- seq_len(ndraws(x))
+    rownames(.draws) <- seq_len(NROW(.draws))
   }
 
+  x <- new_rvar(.draws, .nchains = nchains(x))
+
   if (drop) {
     x <- drop(x)
   }

tests/testthat/test-rvar-slice.R

@@ -165,7 +165,7 @@ test_that("indexing with [ works on a vector", {
   expect_equal(x[NA_integer_], rvar_from_array(x_array[NA_integer_,, drop = FALSE]))
   expect_equal(x[rep(NA_integer_,7)], rvar_from_array(x_array[rep(NA_integer_,7),, drop = FALSE]))
 
-  expect_equal(x[NULL], new_rvar(array(numeric(), dim = c(5, 0))))
+  expect_equal(x[NULL], rvar_from_array(x_array[NULL, , drop = FALSE]))
 
   expect_error(x[1,1])