From 006d1e375864eca67fd3966ddb554521ab83607c Mon Sep 17 00:00:00 2001 From: Matthew Kay Date: Mon, 30 Oct 2023 12:53:13 +1100 Subject: [PATCH 1/3] future-proof cbind() and rbind() for R 4.4 (#304) --- NEWS.md | 1 + R/rvar-bind.R | 14 ++++++++------ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index 729783b4..97f94d1d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,7 @@ * 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()`. +* Future-proof `cbind()` and `rbind()` for R 4.4 (#304). # posterior 1.4.1 diff --git a/R/rvar-bind.R b/R/rvar-bind.R index bcbef822..55c1a58a 100755 --- a/R/rvar-bind.R +++ b/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) } From 804efab5bb0344a33e80221630d7a4a91f471aab Mon Sep 17 00:00:00 2001 From: Matthew Kay Date: Mon, 30 Oct 2023 13:01:25 +1100 Subject: [PATCH 2/3] ensure chol() drops dimnames, for #304 --- R/rvar-math.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/rvar-math.R b/R/rvar-math.R index a8839505..37fae7d0 100755 --- a/R/rvar-math.R +++ b/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)) } From b8f7da1946abecf0268de758ae81ce92734710a4 Mon Sep 17 00:00:00 2001 From: Matthew Kay Date: Mon, 30 Oct 2023 13:22:56 +1100 Subject: [PATCH 3/3] fix rvar test for x[NULL] on R 4.4, for #304 --- NEWS.md | 3 ++- R/rvar-slice.R | 8 ++++---- tests/testthat/test-rvar-slice.R | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index 97f94d1d..abc8cc1e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,7 +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()`. -* Future-proof `cbind()` and `rbind()` for R 4.4 (#304). +* Minor future-proofing of `cbind()`, `rbind()`, and `chol()` + for R 4.4 (#304). # posterior 1.4.1 diff --git a/R/rvar-slice.R b/R/rvar-slice.R index 6f09264c..0129e37a 100755 --- a/R/rvar-slice.R +++ b/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) } diff --git a/tests/testthat/test-rvar-slice.R b/tests/testthat/test-rvar-slice.R index e35b09df..ccaca5a7 100755 --- a/tests/testthat/test-rvar-slice.R +++ b/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])