From dedb6d66eb9e4b73583dc5a79e71c8d3bbf18036 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 2 Mar 2023 11:43:07 -0500 Subject: [PATCH 1/5] Add `is_iv_or_extension()` to ensure extensions can be detected Useful in `iv_span()` when `empty` can be a string or an iv-like object, and we need a definite way to tell if `empty` is iv-like --- R/iv.R | 13 +++++++++++- R/ivs-package.R | 3 +++ R/utils.R | 48 ++++++++++++++++++++++++++++++++++++++++++++ R/zzz.R | 7 +++++-- man/iv-genericity.Rd | 4 +++- 5 files changed, 71 insertions(+), 4 deletions(-) diff --git a/R/iv.R b/R/iv.R index a6a29cb..798ee42 100644 --- a/R/iv.R +++ b/R/iv.R @@ -337,7 +337,9 @@ vec_restore.ivs_iv <- function(x, to, ...) { #' You typically _do_ need an `iv_restore()` method for custom iv extensions. #' If your class is simple, then you can generally just call your constructor, #' like `new_my_iv()`, to restore the class and any additional attributes that -#' might be required. +#' might be required. If your class doesn't use [new_iv()], then an +#' `iv_restore()` method is mandatory, as this is one of the ways that ivs +#' detects that your class is compatible with ivs. #' #' This system allows you to use any `iv_*()` function on your iv extension #' object without having to define S3 methods for all of them. @@ -438,6 +440,15 @@ iv_restore.ivs_iv <- function(x, to, ...) { x } + +is_iv_or_extension <- function(x) { + # If an `iv_restore()` method exists, then we assume that the object is + # an iv extension that has a proxy that returns an iv. This is useful when + # we aren't sure if the object is "iv-like" or not, like in the `missing` + # and `empty` arguments of `iv_span()`. + is_iv(x) || obj_s3_method_exists(x, "iv_restore") +} + # ------------------------------------------------------------------------------ #' @export diff --git a/R/ivs-package.R b/R/ivs-package.R index 793515e..8b50e2a 100644 --- a/R/ivs-package.R +++ b/R/ivs-package.R @@ -8,3 +8,6 @@ #' @importFrom glue glue_collapse ## usethis namespace: end NULL + +# Singletons +the <- new_environment() diff --git a/R/utils.R b/R/utils.R index 9948197..45f813f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -24,3 +24,51 @@ err_locs <- function(x) { glue("`c({x})` and {size - 5L} more") } } + +obj_s3_method_exists <- function(x, generic) { + !is_null(obj_s3_method_lookup(x, generic)) +} + +obj_s3_method_lookup <- function(x, generic) { + if (!is.object(x)) { + return(NULL) + } + + classes <- class(x) + + if (!is_character(classes)) { + abort("`class(x)` didn't return a character vector.", .internal = TRUE) + } + + for (class in classes) { + method <- paste0(generic, ".", class) + method <- s3_method_get(method) + + if (!is_null(method)) { + return(method) + } + } + + NULL +} + +s3_method_get <- function(name) { + # Try global env first in case the user registered a method interactively + env <- global_env() + fn <- env_get(env, name, default = NULL) + + if (is_function(fn)) { + return(fn) + } + + # Then try the package S3 methods table + env <- the$env_s3_methods_table + fn <- env_get(env, name, default = NULL) + + if (is_function(fn)) { + return(fn) + } + + # Symbol not bound to the `env`, or it was bound to a non-function + NULL +} diff --git a/R/zzz.R b/R/zzz.R index 9ec234b..b6ce248 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,10 +1,13 @@ # nocov start .onLoad <- function(libname, pkgname) { - ns <- ns_env(pkgname) + env_ns <- ns_env(pkgname) + + the$env_ns <- env_ns + the$env_s3_methods_table <- env_ns[[".__S3MethodsTable__."]] env_bind( - .env = ns, + .env = env_ns, vec_interval_groups = import_vctrs("exp_vec_interval_groups"), vec_interval_locate_groups = import_vctrs("exp_vec_interval_locate_groups"), vec_interval_complement = import_vctrs("exp_vec_interval_complement"), diff --git a/man/iv-genericity.Rd b/man/iv-genericity.Rd index 4cd4fd7..296ba13 100644 --- a/man/iv-genericity.Rd +++ b/man/iv-genericity.Rd @@ -51,7 +51,9 @@ vector respectively, then you probably need an \code{iv_proxy()} method. You typically \emph{do} need an \code{iv_restore()} method for custom iv extensions. If your class is simple, then you can generally just call your constructor, like \code{new_my_iv()}, to restore the class and any additional attributes that -might be required. +might be required. If your class doesn't use \code{\link[=new_iv]{new_iv()}}, then an +\code{iv_restore()} method is mandatory, as this is one of the ways that ivs +detects that your class is compatible with ivs. This system allows you to use any \verb{iv_*()} function on your iv extension object without having to define S3 methods for all of them. From f029fe9e58cf3c5f9fe647311e59056a60d240b7 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 2 Mar 2023 11:49:29 -0500 Subject: [PATCH 2/5] Implement `iv_span()` --- NAMESPACE | 1 + R/span.R | 217 ++++++++++++++++++++++++++++++++++ man/iv_span.Rd | 89 ++++++++++++++ tests/testthat/_snaps/span.md | 141 ++++++++++++++++++++++ tests/testthat/test-span.R | 164 +++++++++++++++++++++++++ 5 files changed, 612 insertions(+) create mode 100644 man/iv_span.Rd create mode 100644 tests/testthat/_snaps/span.md diff --git a/NAMESPACE b/NAMESPACE index c8dac59..6f3ac2d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(iv_set_difference) export(iv_set_intersect) export(iv_set_symmetric_difference) export(iv_set_union) +export(iv_span) export(iv_splits) export(iv_start) export(iv_symmetric_difference) diff --git a/R/span.R b/R/span.R index 77b83d1..3db4517 100644 --- a/R/span.R +++ b/R/span.R @@ -1,3 +1,220 @@ +#' Span +#' +#' @description +#' `iv_span()` computes the span of an iv. The span is a single interval which +#' encompasses the entire range of the iv. It is similar to [iv_groups()], if +#' groups were also merged across gaps. +#' +#' `iv_span()` is a _summary_ function, like [min()] and [max()], so it always +#' returns a size 1 iv, even for empty ivs. The `empty` argument can be used to +#' control what is returned in the empty case. +#' +#' @details +#' `iv_span()` is currently limited by the fact that it calls [min()] and +#' [max()] internally, which doesn't work for all vector types that ivs +#' supports (mainly data frames). In the future, we hope to be able to leverage +#' `vctrs::vec_min()` and `vctrs::vec_max()`, which don't exist yet. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams iv_groups +#' +#' @param missing `["propagate" / "drop" / "error" / iv(1)]` +#' +#' Handling of missing intervals in `x`. +#' +#' - `"propagate"` forces `iv_span()` to return a missing interval if any +#' missing intervals are detected in `x`. +#' +#' - `"drop"` drops missing intervals before computing the span. If this +#' results in an empty vector, then `empty` will be applied. +#' +#' - `"error"` throws an error if any missing intervals are detected. +#' +#' - If an iv of size 1 is supplied, then this is returned if any missing +#' intervals are detected. It is cast to the type of `x` before returning. +#' +#' @param empty `["missing" / "error" / iv(1)]` +#' +#' Handling of empty `x` vectors. +#' +#' - `"missing"` forces `iv_span()` to return a missing interval if `x` is +#' empty. +#' +#' - `"error"` throws an error if `x` is empty. +#' +#' - If an iv of size 1 is supplied, then this is returned if `x` is empty. It +#' is cast to the type of `x` before returning. +#' +#' @export +#' @examples +#' x <- iv_pairs(c(1, 5), c(2, 6), c(9, 10)) +#' +#' # The span covers the full range of values seen in `x` +#' iv_span(x) +#' +#' # Compare against `iv_groups()`, which merges overlaps but doesn't merge +#' # across gaps +#' iv_groups(x) +#' +#' x <- iv_pairs(c(1, 3), c(NA, NA), c(5, 6), c(NA, NA)) +#' +#' # Because `iv_span()` is a summary function, if any missing intervals are +#' # present then it returns a missing interval by default +#' iv_span(x) +#' +#' # Further control this with `missing` +#' iv_span(x, missing = "drop") +#' try(iv_span(x, missing = "error")) +#' iv_span(x, missing = iv(-1, 0)) +#' +#' x <- iv(double(), double()) +#' +#' # If `x` is empty, then by default a missing interval is returned +#' iv_span(x) +#' +#' # Control this with `empty` +#' try(iv_span(x, empty = "error")) +#' iv_span(x, empty = iv(-Inf, Inf)) +#' +#' # `empty` kicks in if `missing = "drop"` is used and all elements were +#' # missing +#' x <- iv(c(NA, NA), c(NA, NA), ptype = double()) +#' iv_span(x, missing = "drop", empty = iv(-Inf, Inf)) +iv_span <- function(x, ..., missing = "propagate", empty = "missing") { + check_dots_empty0(...) + + proxy <- iv_proxy(x) + check_iv(proxy, arg = "x") + + missing <- check_span_missing(missing, x) + empty <- check_span_empty(empty, x) + + start <- field_start(proxy) + end <- field_end(proxy) + + if (vec_any_missing(start)) { + switch( + missing$string, + drop = { + not_missing <- !vec_detect_missing(start) + not_missing <- which(not_missing) + start <- vec_slice(start, not_missing) + end <- vec_slice(end, not_missing) + }, + propagate = { + return(vec_init(x)) + }, + value = { + return(missing$value) + }, + error = { + abort("`x` can't contain missing values.") + } + ) + } + + if (vec_is_empty(start)) { + switch( + empty$string, + missing = { + return(vec_init(x)) + }, + value = { + return(empty$value) + }, + error = { + abort("`x` can't be empty.") + } + ) + } + + # TODO: `vec_min()` and `vec_max()` + # https://github.com/r-lib/vctrs/issues/86 + start <- min(start) + end <- max(end) + + out <- new_bare_iv(start, end) + out <- iv_restore(out, x) + + out +} + +check_span_missing <- function(missing, x, ..., error_call = caller_env()) { + if (is_string(missing)) { + missing <- arg_match0( + arg = missing, + values = c("propagate", "drop", "error"), + error_call = error_call + ) + + out <- list( + string = missing, + value = NULL + ) + + return(out) + } + + if (is_iv_or_extension(missing)) { + vec_check_size(missing, size = 1L, call = error_call) + + missing <- vec_cast( + x = missing, + to = x, + x_arg = "missing", + to_arg = "x", + call = error_call + ) + + out <- list( + string = "value", + value = missing + ) + + return(out) + } + + stop_input_type(missing, what = "a string or an iv", call = error_call) +} + +check_span_empty <- function(empty, x, ..., error_call = caller_env()) { + if (is_string(empty)) { + empty <- arg_match0( + arg = empty, + values = c("missing", "error"), + error_call = error_call + ) + + out <- list( + string = empty, + value = NULL + ) + + return(out) + } + + if (is_iv_or_extension(empty)) { + vec_check_size(empty, size = 1L, call = error_call) + + empty <- vec_cast( + x = empty, + to = x, + x_arg = "empty", + to_arg = "x", + call = error_call + ) + + out <- list( + string = "value", + value = empty + ) + + return(out) + } + + stop_input_type(empty, what = "a string or an iv", call = error_call) +} + #' Pairwise span #' #' @description diff --git a/man/iv_span.Rd b/man/iv_span.Rd new file mode 100644 index 0000000..2336db8 --- /dev/null +++ b/man/iv_span.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/span.R +\name{iv_span} +\alias{iv_span} +\title{Span} +\usage{ +iv_span(x, ..., missing = "propagate", empty = "missing") +} +\arguments{ +\item{x}{\verb{[iv]} + +An interval vector.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{missing}{\verb{["propagate" / "drop" / "error" / iv(1)]} + +Handling of missing intervals in \code{x}. +\itemize{ +\item \code{"propagate"} forces \code{iv_span()} to return a missing interval if any +missing intervals are detected in \code{x}. +\item \code{"drop"} drops missing intervals before computing the span. If this +results in an empty vector, then \code{empty} will be applied. +\item \code{"error"} throws an error if any missing intervals are detected. +\item If an iv of size 1 is supplied, then this is returned if any missing +intervals are detected. It is cast to the type of \code{x} before returning. +}} + +\item{empty}{\verb{["missing" / "error" / iv(1)]} + +Handling of empty \code{x} vectors. +\itemize{ +\item \code{"missing"} forces \code{iv_span()} to return a missing interval if \code{x} is +empty. +\item \code{"error"} throws an error if \code{x} is empty. +\item If an iv of size 1 is supplied, then this is returned if \code{x} is empty. It +is cast to the type of \code{x} before returning. +}} +} +\description{ +\code{iv_span()} computes the span of an iv. The span is a single interval which +encompasses the entire range of the iv. It is similar to \code{\link[=iv_groups]{iv_groups()}}, if +groups were also merged across gaps. + +\code{iv_span()} is a \emph{summary} function, like \code{\link[=min]{min()}} and \code{\link[=max]{max()}}, so it always +returns a size 1 iv, even for empty ivs. The \code{empty} argument can be used to +control what is returned in the empty case. +} +\details{ +\code{iv_span()} is currently limited by the fact that it calls \code{\link[=min]{min()}} and +\code{\link[=max]{max()}} internally, which doesn't work for all vector types that ivs +supports (mainly data frames). In the future, we hope to be able to leverage +\code{vctrs::vec_min()} and \code{vctrs::vec_max()}, which don't exist yet. +} +\examples{ +x <- iv_pairs(c(1, 5), c(2, 6), c(9, 10)) + +# The span covers the full range of values seen in `x` +iv_span(x) + +# Compare against `iv_groups()`, which merges overlaps but doesn't merge +# across gaps +iv_groups(x) + +x <- iv_pairs(c(1, 3), c(NA, NA), c(5, 6), c(NA, NA)) + +# Because `iv_span()` is a summary function, if any missing intervals are +# present then it returns a missing interval by default +iv_span(x) + +# Further control this with `missing` +iv_span(x, missing = "drop") +try(iv_span(x, missing = "error")) +iv_span(x, missing = iv(-1, 0)) + +x <- iv(double(), double()) + +# If `x` is empty, then by default a missing interval is returned +iv_span(x) + +# Control this with `empty` +try(iv_span(x, empty = "error")) +iv_span(x, empty = iv(-Inf, Inf)) + +# `empty` kicks in if `missing = "drop"` is used and all elements were +# missing +x <- iv(c(NA, NA), c(NA, NA), ptype = double()) +iv_span(x, missing = "drop", empty = iv(-Inf, Inf)) +} diff --git a/tests/testthat/_snaps/span.md b/tests/testthat/_snaps/span.md new file mode 100644 index 0000000..ff62f31 --- /dev/null +++ b/tests/testthat/_snaps/span.md @@ -0,0 +1,141 @@ +# missing + `missing = error` errors + + Code + iv_span(x, missing = "error") + Condition + Error in `iv_span()`: + ! `x` can't contain missing values. + +# missing + `missing = drop` + `empty = error` errors + + Code + iv_span(x, missing = "drop", empty = "error") + Condition + Error in `iv_span()`: + ! `x` can't be empty. + +# empty + `empty = error` errors + + Code + iv_span(x, empty = "error") + Condition + Error in `iv_span()`: + ! `x` can't be empty. + +# span casts pre-proxied `empty` to pre-proxied type of `x` + + Code + iv_span(x, empty = empty) + Condition + Error in `iv_span()`: + ! Can't convert `empty` > to match type of `x` . + +--- + + Code + iv_span(x, empty = empty) + Condition + Error in `iv_span()`: + ! Can't convert `empty` to match type of `x` >. + +# span casts pre-proxied `missing` to pre-proxied type of `x` + + Code + iv_span(x, missing = missing) + Condition + Error in `iv_span()`: + ! Can't convert `missing` > to match type of `x` . + +--- + + Code + iv_span(x, missing = missing) + Condition + Error in `iv_span()`: + ! Can't convert `missing` to match type of `x` >. + +# errors on non-empty dots + + Code + iv_span(x, 2) + Condition + Error in `iv_span()`: + ! `...` must be empty. + x Problematic argument: + * ..1 = 2 + i Did you forget to name an argument? + +# validates `x` is an iv + + Code + iv_span(1) + Condition + Error in `iv_span()`: + ! `x` must be an , not the number 1. + +# validates `empty` + + Code + iv_span(x, empty = "x") + Condition + Error in `iv_span()`: + ! `empty` must be one of "missing" or "error", not "x". + +--- + + Code + iv_span(x, empty = 1) + Condition + Error in `iv_span()`: + ! `empty` must be a string or an iv, not the number 1. + +--- + + Code + iv_span(x, empty = iv(1.5, 2.5)) + Condition + Error in `iv_span()`: + ! Can't convert from `empty` to `x` due to loss of precision. + * Locations: 1 + +--- + + Code + iv_span(x, empty = iv(1:2, 2:3)) + Condition + Error in `iv_span()`: + ! `empty` must have size 1, not size 2. + +# validates `missing` + + Code + iv_span(x, missing = "x") + Condition + Error in `iv_span()`: + ! `missing` must be one of "propagate", "drop", or "error", not "x". + +--- + + Code + iv_span(x, missing = 1) + Condition + Error in `iv_span()`: + ! `missing` must be a string or an iv, not the number 1. + +--- + + Code + iv_span(x, missing = iv(1.5, 2.5)) + Condition + Error in `iv_span()`: + ! Can't convert from `missing` to `x` due to loss of precision. + * Locations: 1 + +--- + + Code + iv_span(x, missing = iv(1:2, 2:3)) + Condition + Error in `iv_span()`: + ! `missing` must have size 1, not size 2. + diff --git a/tests/testthat/test-span.R b/tests/testthat/test-span.R index 113d0e9..f0afabd 100644 --- a/tests/testthat/test-span.R +++ b/tests/testthat/test-span.R @@ -1,3 +1,167 @@ +# ------------------------------------------------------------------------------ +# iv_span() + +test_that("takes the span over the whole range", { + x <- iv_pairs(c(1, 3), c(7, 10), c(-6, -2), c(9, 12)) + + expect_identical(iv_span(x), iv(-6, 12)) +}) + +test_that("missing + `missing = propagate` returns missing value", { + x <- iv_pairs(c(1, 3), c(NA, NA), c(-5, -1)) + expect_identical(iv_span(x), iv(NA_real_, NA_real_)) +}) + +test_that("missing + `missing = error` errors", { + x <- iv_pairs(c(1, 3), c(NA, NA), c(-5, -1)) + + expect_snapshot(error = TRUE, { + iv_span(x, missing = "error") + }) +}) + +test_that("missing + `missing = ` returns `missing` value", { + x <- iv_pairs(c(1, 3), c(NA, NA), c(-5, -1)) + missing <- iv(-Inf, Inf) + expect_identical(iv_span(x, missing = missing), missing) +}) + +test_that("missing + `missing = drop` filters out missings", { + x <- iv_pairs(c(1, 3), c(NA, NA), c(-5, -1)) + expect_identical(iv_span(x, missing = "drop"), iv(-5, 3)) +}) + +test_that("missing + `missing = drop` + `empty = missing` returns missing value", { + x <- iv_pairs(c(NA, NA), c(NA, NA)) + expect_identical(iv_span(x, missing = "drop"), iv(NA, NA)) +}) + +test_that("missing + `missing = drop` + `empty = error` errors", { + x <- iv_pairs(c(NA, NA), c(NA, NA), ptype = double()) + + expect_snapshot(error = TRUE, { + iv_span(x, missing = "drop", empty = "error") + }) +}) + +test_that("missing + `missing = drop` + `empty = ` returns `empty` value", { + x <- iv_pairs(c(NA, NA), c(NA, NA), ptype = double()) + empty <- iv(-Inf, Inf) + expect_identical(iv_span(x, missing = "drop", empty = empty), empty) +}) + +test_that("empty + `empty = missing` returns missing value", { + x <- iv(integer(), integer()) + expect_identical(iv_span(x), iv(NA_integer_, NA_integer_)) +}) + +test_that("empty + `empty = error` errors", { + x <- iv(integer(), integer()) + + expect_snapshot(error = TRUE, { + iv_span(x, empty = "error") + }) +}) + +test_that("empty + `empty = ` returns `empty` value", { + x <- iv(integer(), integer()) + empty <- iv(0L, 1L) + expect_identical(iv_span(x, empty = empty), empty) +}) + +test_that("span is generic over the container", { + x <- nested_integer_iv_pairs(c(-5, 0), c(2, 4)) + expect_identical(iv_span(x), nested_integer_iv(-5, 4)) + + x <- nested_integer_iv_pairs(c(-5, 0), c(2, 4), c(NA, NA)) + expect_identical(iv_span(x), nested_integer_iv(NA, NA)) + expect_identical(iv_span(x, missing = "drop"), nested_integer_iv(-5, 4)) +}) + +test_that("span casts pre-proxied `empty` to pre-proxied type of `x`", { + x <- nested_integer_iv(integer(), integer()) + empty <- nested_integer_iv(0, 1) + expect_identical(iv_span(x, empty = empty), empty) + + x <- nested_integer_iv(integer(), integer()) + empty <- iv(0, 1) + expect_snapshot(error = TRUE, { + iv_span(x, empty = empty) + }) + + x <- iv(integer(), integer()) + empty <- nested_integer_iv(0, 1) + expect_snapshot(error = TRUE, { + iv_span(x, empty = empty) + }) +}) + +test_that("span casts pre-proxied `missing` to pre-proxied type of `x`", { + x <- nested_integer_iv(NA, NA) + missing <- nested_integer_iv(0, 1) + expect_identical(iv_span(x, missing = missing), missing) + + x <- nested_integer_iv(NA, NA) + missing <- iv(0L, 1L) + expect_snapshot(error = TRUE, { + iv_span(x, missing = missing) + }) + + x <- iv(NA, NA, ptype = integer()) + missing <- nested_integer_iv(0, 1) + expect_snapshot(error = TRUE, { + iv_span(x, missing = missing) + }) +}) + +test_that("errors on non-empty dots", { + x <- iv(1, 2) + + expect_snapshot(error = TRUE, { + iv_span(x, 2) + }) +}) + +test_that("validates `x` is an iv", { + expect_snapshot(error = TRUE, { + iv_span(1) + }) +}) + +test_that("validates `empty`", { + x <- iv(integer(), integer()) + + expect_snapshot(error = TRUE, { + iv_span(x, empty = "x") + }) + expect_snapshot(error = TRUE, { + iv_span(x, empty = 1) + }) + expect_snapshot(error = TRUE, { + iv_span(x, empty = iv(1.5, 2.5)) + }) + expect_snapshot(error = TRUE, { + iv_span(x, empty = iv(1:2, 2:3)) + }) +}) + +test_that("validates `missing`", { + x <- iv(integer(), integer()) + + expect_snapshot(error = TRUE, { + iv_span(x, missing = "x") + }) + expect_snapshot(error = TRUE, { + iv_span(x, missing = 1) + }) + expect_snapshot(error = TRUE, { + iv_span(x, missing = iv(1.5, 2.5)) + }) + expect_snapshot(error = TRUE, { + iv_span(x, missing = iv(1:2, 2:3)) + }) +}) + # ------------------------------------------------------------------------------ # iv_pairwise_span() From f7f8362f67807454f56f40f386ceb613733bd592 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 2 Mar 2023 11:49:58 -0500 Subject: [PATCH 3/5] Use `iv_span()` in set helpers --- R/set.R | 51 +++++++++++++++++++++------------------------------ 1 file changed, 21 insertions(+), 30 deletions(-) diff --git a/R/set.R b/R/set.R index 3d73cf5..01ea39e 100644 --- a/R/set.R +++ b/R/set.R @@ -182,16 +182,13 @@ iv_set_intersect <- function(x, y) { check_iv(x_proxy, arg = "x") check_iv(y_proxy, arg = "y") - # TODO: `vec_min()` and `vec_max()` - # https://github.com/r-lib/vctrs/issues/86 - lower <- min( - min(field_start(x_proxy)), - min(field_start(y_proxy)) - ) - upper <- max( - max(field_end(x_proxy)), - max(field_end(y_proxy)) - ) + x_span <- iv_span(x_proxy, missing = "error", empty = "error") + y_span <- iv_span(y_proxy, missing = "error", empty = "error") + + span <- iv_span(vec_c(x_span, y_span), missing = "error", empty = "error") + + lower <- field_start(span) + upper <- field_end(span) x_c <- iv_set_complement(x_proxy, lower = lower, upper = upper) y_c <- iv_set_complement(y_proxy, lower = lower, upper = upper) @@ -245,16 +242,13 @@ iv_set_difference <- function(x, y) { check_iv(x_proxy, arg = "x") check_iv(y_proxy, arg = "y") - # TODO: `vec_min()` and `vec_max()` - # https://github.com/r-lib/vctrs/issues/86 - lower <- min( - min(field_start(x_proxy)), - min(field_start(y_proxy)) - ) - upper <- max( - max(field_end(x_proxy)), - max(field_end(y_proxy)) - ) + x_span <- iv_span(x_proxy, missing = "error", empty = "error") + y_span <- iv_span(y_proxy, missing = "error", empty = "error") + + span <- iv_span(vec_c(x_span, y_span), missing = "error", empty = "error") + + lower <- field_start(span) + upper <- field_end(span) x_c <- iv_set_complement(x_proxy, lower = lower, upper = upper) @@ -307,16 +301,13 @@ iv_set_symmetric_difference <- function(x, y) { check_iv(x_proxy, arg = "x") check_iv(y_proxy, arg = "y") - # TODO: `vec_min()` and `vec_max()` - # https://github.com/r-lib/vctrs/issues/86 - lower <- min( - min(field_start(x_proxy)), - min(field_start(y_proxy)) - ) - upper <- max( - max(field_end(x_proxy)), - max(field_end(y_proxy)) - ) + x_span <- iv_span(x_proxy, missing = "error", empty = "error") + y_span <- iv_span(y_proxy, missing = "error", empty = "error") + + span <- iv_span(vec_c(x_span, y_span), missing = "error", empty = "error") + + lower <- field_start(span) + upper <- field_end(span) x_c <- iv_set_complement(x_proxy, lower = lower, upper = upper) x_c_union_y <- iv_set_union(x_c, y_proxy) From 376b52f2fbfda0ab1d3721f11120d5692d268a08 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 2 Mar 2023 11:50:08 -0500 Subject: [PATCH 4/5] Tweak pkgdown reference --- _pkgdown.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 4e3cf0d..cbf68fa 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,14 +13,12 @@ reference: - iv_diff - iv_start - - title: Single vector operations + - title: Core operations contents: - iv_groups - iv_splits - iv_containers - - - title: Binary vector operations - contents: + - iv_span - iv_pairwise_span - title: Relationships between two ivs From 19276110a47978160ee3d1d0e236262a3033bcb9 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 2 Mar 2023 11:56:15 -0500 Subject: [PATCH 5/5] NEWS bullet --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7611ee8..f240eae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,6 +30,9 @@ * New `iv_diff()` for generating an iv from an existing vector that is in strictly increasing order (#17). +* New `iv_span()` for computing a summary interval that encompasses the entire + range of an existing iv (#49). + * New Examples vignette that links out to Stack Overflow questions that were solved with ivs. View it locally with `vignette("examples", package = "ivs")`.