1# proxies ----------------------------------------------------------------- 2 3#' Comparison and order proxy 4#' 5#' @description 6#' `vec_proxy_compare()` and `vec_proxy_order()` return proxy objects, i.e. 7#' an atomic vector or data frame of atomic vectors. 8#' 9#' For [`vctrs_vctr`][vctr] objects: 10#' 11#' - `vec_proxy_compare()` determines the behavior of `<`, `>`, `>=` 12#' and `<=` (via [vec_compare()]); and [min()], [max()], [median()], and 13#' [quantile()]. 14#' 15#' - `vec_proxy_order()` determines the behavior of `order()` and `sort()` 16#' (via `xtfrm()`). 17#' 18#' @details 19#' The default method of `vec_proxy_compare()` assumes that all classes built 20#' on top of atomic vectors or records are comparable. Internally the default 21#' calls [vec_proxy_equal()]. If your class is not comparable, you will need 22#' to provide a `vec_proxy_compare()` method that throws an error. 23#' 24#' The behavior of `vec_proxy_order()` is identical to `vec_proxy_compare()`, 25#' with the exception of lists. Lists are not comparable, as comparing 26#' elements of different types is undefined. However, to allow ordering of 27#' data frames containing list-columns, the ordering proxy of a list is 28#' generated as an integer vector that can be used to order list elements 29#' by first appearance. 30#' 31#' @param x A vector x. 32#' @inheritParams ellipsis::dots_empty 33#' @return A 1d atomic vector or a data frame. 34#' 35#' @section Dependencies: 36#' - [vec_proxy_equal()] called by default in `vec_proxy_compare()` 37#' - [vec_proxy_compare()] called by default in `vec_proxy_order()` 38#' 39#' @keywords internal 40#' @export 41#' @examples 42#' # Lists are not comparable 43#' x <- list(1:2, 1, 1:2, 3) 44#' try(vec_compare(x, x)) 45#' 46#' # But lists are orderable by first appearance to allow for 47#' # ordering data frames with list-cols 48#' df <- new_data_frame(list(x = x)) 49#' vec_sort(df) 50vec_proxy_compare <- function(x, ...) { 51 if (!missing(...)) { 52 # For backward compatibility with older dplyr versions 53 if (match_relax(...)) { 54 return(vec_proxy_order(x)) 55 } 56 ellipsis::check_dots_empty() 57 } 58 return(.Call(vctrs_proxy_compare, x)) 59 UseMethod("vec_proxy_compare") 60} 61#' @export 62vec_proxy_compare.default <- function(x, ...) { 63 stop_native_implementation("vec_proxy_compare.default") 64} 65 66match_relax <- function(..., relax = FALSE) { 67 relax 68} 69 70#' @rdname vec_proxy_compare 71#' @export 72vec_proxy_order <- function(x, ...) { 73 if (!missing(...)) { 74 ellipsis::check_dots_empty() 75 } 76 return(.Call(vctrs_proxy_order, x)) 77 UseMethod("vec_proxy_order") 78} 79 80#' @export 81vec_proxy_order.default <- function(x, ...) { 82 stop_native_implementation("vec_proxy_order.default") 83} 84 85# compare ----------------------------------------------------------------- 86 87#' Compare two vectors 88#' 89#' @section S3 dispatch: 90#' `vec_compare()` is not generic for performance; instead it uses 91#' [vec_proxy_compare()] to 92#' 93#' @param x,y Vectors with compatible types and lengths. 94#' @param na_equal Should `NA` values be considered equal? 95#' @param .ptype Override to optionally specify common type 96#' @return An integer vector with values -1 for `x < y`, 0 if `x == y`, 97#' and 1 if `x > y`. If `na_equal` is `FALSE`, the result will be `NA` 98#' if either `x` or `y` is `NA`. 99#' 100#' @section Dependencies: 101#' - [vec_cast_common()] with fallback 102#' - [vec_recycle_common()] 103#' - [vec_proxy_compare()] 104#' 105#' @export 106#' @examples 107#' vec_compare(c(TRUE, FALSE, NA), FALSE) 108#' vec_compare(c(TRUE, FALSE, NA), FALSE, na_equal = TRUE) 109#' 110#' vec_compare(1:10, 5) 111#' vec_compare(runif(10), 0.5) 112#' vec_compare(letters[1:10], "d") 113#' 114#' df <- data.frame(x = c(1, 1, 1, 2), y = c(0, 1, 2, 1)) 115#' vec_compare(df, data.frame(x = 1, y = 1)) 116vec_compare <- function(x, y, na_equal = FALSE, .ptype = NULL) { 117 vec_assert(x) 118 vec_assert(y) 119 vec_assert(na_equal, ptype = logical(), size = 1L) 120 121 args <- vec_recycle_common(x, y) 122 args <- vec_cast_common_params( 123 !!!args, 124 .to = .ptype, 125 .df_fallback = DF_FALLBACK_quiet 126 ) 127 128 .Call(vctrs_compare, vec_proxy_compare(args[[1]]), vec_proxy_compare(args[[2]]), na_equal) 129} 130 131 132# Helpers ----------------------------------------------------------------- 133 134# Used for testing 135cmp <- function(x, y) (x > y) - (x < y) 136