diff --git a/R/type-vctr.R b/R/type-vctr.R index 57c964355..39243e044 100644 --- a/R/type-vctr.R +++ b/R/type-vctr.R @@ -545,6 +545,23 @@ 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, ...) + } + if (vec_is_empty(x)) { return(vec_cast_or_na(Inf, x)) } @@ -566,6 +583,23 @@ 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, ...) + } + if (vec_is_empty(x)) { return(vec_cast_or_na(-Inf, x)) } @@ -587,6 +621,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/_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 f47a8aa9e..78705aaa1 100644 --- a/tests/testthat/test-type-vctr.R +++ b/tests/testthat/test-type-vctr.R @@ -632,6 +632,43 @@ test_that("Summary generics behave identically to base for empty vctrs (#88)", { ) }) +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 arguments as expected (#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)", { x <- new_vctr(c(1, 2)) expect_identical(is.finite(x), c(TRUE, TRUE))