From 98cc017cc384bbab6dfcaef5e32df5a83fd3e521 Mon Sep 17 00:00:00 2001 From: "Logan C. Brooks" Date: Tue, 16 Jul 2024 21:36:23 -0700 Subject: [PATCH 1/4] Combine x and ... in min, max, range Only call `vec_c` if dots are nonempty to stay fast in the empty case. --- R/type-vctr.R | 12 ++++++++++++ tests/testthat/test-type-vctr.R | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/R/type-vctr.R b/R/type-vctr.R index 57c964355..f202d7ba5 100644 --- a/R/type-vctr.R +++ b/R/type-vctr.R @@ -545,6 +545,10 @@ vec_cast_or_na <- function(x, to, ...) { #' @export min.vctrs_vctr <- function(x, ..., na.rm = FALSE) { + if (dots_n(...) != 0L) { + x <- vec_c(x, ...) + } + if (vec_is_empty(x)) { return(vec_cast_or_na(Inf, x)) } @@ -566,6 +570,10 @@ min.vctrs_vctr <- function(x, ..., na.rm = FALSE) { #' @export max.vctrs_vctr <- function(x, ..., na.rm = FALSE) { + if (dots_n(...) != 0L) { + x <- vec_c(x, ...) + } + if (vec_is_empty(x)) { return(vec_cast_or_na(-Inf, x)) } @@ -587,6 +595,10 @@ max.vctrs_vctr <- function(x, ..., na.rm = FALSE) { #' @export range.vctrs_vctr <- function(x, ..., na.rm = FALSE) { + if (dots_n(...) != 0L) { + x <- vec_c(x, ...) + } + if (vec_is_empty(x)) { return(vec_cast_or_na(c(Inf, -Inf), x)) } diff --git a/tests/testthat/test-type-vctr.R b/tests/testthat/test-type-vctr.R index f47a8aa9e..a5bfede03 100644 --- a/tests/testthat/test-type-vctr.R +++ b/tests/testthat/test-type-vctr.R @@ -632,6 +632,18 @@ test_that("Summary generics behave identically to base for empty vctrs (#88)", { ) }) +test_that("methods combine `x` and `...` when generic expects them to (#1372)", { + x <- new_vctr(1) + y <- new_vctr(3) + + expect_identical(min(x, y), x) + expect_identical(min(y, x), x) + expect_identical(max(x, y), y) + expect_identical(max(y, x), y) + expect_identical(range(x, y), c(x, y)) + expect_identical(range(y, x), c(x, y)) +}) + test_that("generic predicates return logical vectors (#251)", { x <- new_vctr(c(1, 2)) expect_identical(is.finite(x), c(TRUE, TRUE)) From ccca8172f7fc6e307a0573a337f819d8ee98ae20 Mon Sep 17 00:00:00 2001 From: "Logan C. Brooks" Date: Sun, 30 Mar 2025 18:19:11 -0700 Subject: [PATCH 2/4] Make `range.vctrs_vctr` prototype identical to `range` --- R/type-vctr.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/type-vctr.R b/R/type-vctr.R index f202d7ba5..5302e6e9d 100644 --- a/R/type-vctr.R +++ b/R/type-vctr.R @@ -594,10 +594,8 @@ max.vctrs_vctr <- function(x, ..., na.rm = FALSE) { } #' @export -range.vctrs_vctr <- function(x, ..., na.rm = FALSE) { - if (dots_n(...) != 0L) { - x <- vec_c(x, ...) - } +range.vctrs_vctr <- function(..., na.rm = FALSE) { + x <- vec_c(...) if (vec_is_empty(x)) { return(vec_cast_or_na(c(Inf, -Inf), x)) From fe3278072e9149e3597df837564d519054cba504 Mon Sep 17 00:00:00 2001 From: "Logan C. Brooks" Date: Sun, 30 Mar 2025 18:32:31 -0700 Subject: [PATCH 3/4] Make `min` and `max` check sizes of `x` and `...` for clear intent --- R/type-vctr.R | 26 +++++++++++++++++++++ tests/testthat/_snaps/type-vctr.md | 36 ++++++++++++++++++++++++++++++ tests/testthat/test-type-vctr.R | 27 +++++++++++++++++++++- 3 files changed, 88 insertions(+), 1 deletion(-) diff --git a/R/type-vctr.R b/R/type-vctr.R index 5302e6e9d..fdf929fbd 100644 --- a/R/type-vctr.R +++ b/R/type-vctr.R @@ -546,6 +546,19 @@ vec_cast_or_na <- function(x, to, ...) { #' @export min.vctrs_vctr <- function(x, ..., na.rm = FALSE) { if (dots_n(...) != 0L) { + sizes <- list_sizes(list(x, ...)) + if (any(sizes != 1L)) { + cli::cli_abort(c( + "Can't use `...` unless {.arg x} and each of {.arg ...} are of size 1.", + "i" = "Size of {.arg x} was {vec_size(x)}", + "i" = "{cli::qty(rlang::dots_n(...))} + Size{?s} of {.arg ...} {?was/were} {list_sizes(list(...))}", + ">" = "If you wanted a size-1 result with the overall {.fn min}, + use {.code min(c())}", + ">" = "If you wanted a vectorized/parallel {.fn pmin}, + use {.code pmin()}" + ), class = "vctrs_error_min_intent_uncertain") + } x <- vec_c(x, ...) } @@ -571,6 +584,19 @@ min.vctrs_vctr <- function(x, ..., na.rm = FALSE) { #' @export max.vctrs_vctr <- function(x, ..., na.rm = FALSE) { if (dots_n(...) != 0L) { + sizes <- list_sizes(list(x, ...)) + if (any(sizes != 1L)) { + cli::cli_abort(c( + "Can't use `...` unless {.arg x} and each of {.arg ...} are of size 1.", + "i" = "Size of {.arg x} was {vec_size(x)}", + "i" = "{cli::qty(rlang::dots_n(...))} + Size{?s} of {.arg ...} {?was/were} {list_sizes(list(...))}", + ">" = "If you wanted a size-1 result with the overall {.fn max}, + use {.code max(c())}", + ">" = "If you wanted a vectorized/parallel {.fn pmax}, + use {.code pmax()}" + ), class = "vctrs_error_max_intent_uncertain") + } x <- vec_c(x, ...) } diff --git a/tests/testthat/_snaps/type-vctr.md b/tests/testthat/_snaps/type-vctr.md index fb7f5daf9..491d19a6f 100644 --- a/tests/testthat/_snaps/type-vctr.md +++ b/tests/testthat/_snaps/type-vctr.md @@ -37,3 +37,39 @@ A B C xxx xxx xxx +# `min` and `max` either combine `x` and `...` or abort (#1372) + + Code + min(rep(x, 5), y) + Condition + Error: + ! Can't use `...` unless `x` and each of `...` are of size 1. + i Size of `x` was 5 + i Size of `...` was 1 + > If you wanted a size-1 result with the overall `min()`, use `min(c())` + > If you wanted a vectorized/parallel `pmin()`, use `pmin()` + +--- + + Code + min(x, rep(y, 5), z) + Condition + Error: + ! Can't use `...` unless `x` and each of `...` are of size 1. + i Size of `x` was 1 + i Sizes of `...` were 5 and 1 + > If you wanted a size-1 result with the overall `min()`, use `min(c())` + > If you wanted a vectorized/parallel `pmin()`, use `pmin()` + +--- + + Code + max(rep(x, 5), y) + Condition + Error: + ! Can't use `...` unless `x` and each of `...` are of size 1. + i Size of `x` was 5 + i Size of `...` was 1 + > If you wanted a size-1 result with the overall `max()`, use `max(c())` + > If you wanted a vectorized/parallel `pmax()`, use `pmax()` + diff --git a/tests/testthat/test-type-vctr.R b/tests/testthat/test-type-vctr.R index a5bfede03..f53952378 100644 --- a/tests/testthat/test-type-vctr.R +++ b/tests/testthat/test-type-vctr.R @@ -632,16 +632,41 @@ test_that("Summary generics behave identically to base for empty vctrs (#88)", { ) }) -test_that("methods combine `x` and `...` when generic expects them to (#1372)", { +test_that("`min` and `max` either combine `x` and `...` or abort (#1372)", { x <- new_vctr(1) y <- new_vctr(3) + z <- new_vctr(5) expect_identical(min(x, y), x) expect_identical(min(y, x), x) expect_identical(max(x, y), y) expect_identical(max(y, x), y) + + expect_identical(min(x, y, z), x) + expect_identical(max(x, y, z), z) + + expect_error(min(rep(x, 5), y), class = "vctrs_error_min_intent_uncertain") + expect_error(min(x, rep(y, 5)), class = "vctrs_error_min_intent_uncertain") + expect_error(min(rep(x, 0), y), class = "vctrs_error_min_intent_uncertain") + expect_error(min(x, rep(y, 0)), class = "vctrs_error_min_intent_uncertain") + expect_error(max(rep(x, 5), y), class = "vctrs_error_max_intent_uncertain") + expect_error(max(x, rep(y, 5)), class = "vctrs_error_max_intent_uncertain") + expect_error(max(rep(x, 0), y), class = "vctrs_error_max_intent_uncertain") + expect_error(max(x, rep(y, 0)), class = "vctrs_error_max_intent_uncertain") + + expect_snapshot(min(rep(x, 5), y), error = TRUE, cnd_class = TRUE) + expect_snapshot(min(x, rep(y, 5), z), error = TRUE, cnd_class = TRUE) + expect_snapshot(max(rep(x, 5), y), error = TRUE, cnd_class = TRUE) +}) + +test_that("`range` combines `...` (#1372)", { + x <- new_vctr(1) + y <- new_vctr(3) + z <- new_vctr(as.numeric(13:11)) + expect_identical(range(x, y), c(x, y)) expect_identical(range(y, x), c(x, y)) + expect_identical(range(x, y, z), c(x, z[[1]])) }) test_that("generic predicates return logical vectors (#251)", { From 8e0f62e3afe18bbe6ab8a53256a0312c2a1df743 Mon Sep 17 00:00:00 2001 From: "Logan C. Brooks" Date: Sun, 30 Mar 2025 18:50:29 -0700 Subject: [PATCH 4/4] Return to `range(x, ..., na.rm = FALSE)` prototype for common speedup The `range` generic doesn't separate out `x` and `...`, but splitting them out lets us easily check whether we can skip a potentially-slow `vec_c` operation to combine them. --- R/type-vctr.R | 6 ++++-- tests/testthat/test-type-vctr.R | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/type-vctr.R b/R/type-vctr.R index fdf929fbd..39243e044 100644 --- a/R/type-vctr.R +++ b/R/type-vctr.R @@ -620,8 +620,10 @@ max.vctrs_vctr <- function(x, ..., na.rm = FALSE) { } #' @export -range.vctrs_vctr <- function(..., na.rm = FALSE) { - x <- vec_c(...) +range.vctrs_vctr <- function(x, ..., na.rm = FALSE) { + if (dots_n(...) != 0L) { + x <- vec_c(x, ...) + } if (vec_is_empty(x)) { return(vec_cast_or_na(c(Inf, -Inf), x)) diff --git a/tests/testthat/test-type-vctr.R b/tests/testthat/test-type-vctr.R index f53952378..78705aaa1 100644 --- a/tests/testthat/test-type-vctr.R +++ b/tests/testthat/test-type-vctr.R @@ -659,7 +659,7 @@ test_that("`min` and `max` either combine `x` and `...` or abort (#1372)", { expect_snapshot(max(rep(x, 5), y), error = TRUE, cnd_class = TRUE) }) -test_that("`range` combines `...` (#1372)", { +test_that("`range` combines arguments as expected (#1372)", { x <- new_vctr(1) y <- new_vctr(3) z <- new_vctr(as.numeric(13:11))