-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Implement to_int() as proof of concept. (#3)
* Implement to_int() as proof of concept. * Add cli to imports. * Add tests for factors.
- Loading branch information
1 parent
18d27bd
commit e623bbd
Showing
11 changed files
with
695 additions
and
36 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,2 +1,13 @@ | ||
# Generated by roxygen2: do not edit by hand | ||
|
||
S3method(.to_int_impl,"NULL") | ||
S3method(.to_int_impl,character) | ||
S3method(.to_int_impl,complex) | ||
S3method(.to_int_impl,default) | ||
S3method(.to_int_impl,double) | ||
S3method(.to_int_impl,factor) | ||
S3method(.to_int_impl,hexmode) | ||
S3method(.to_int_impl,integer) | ||
S3method(.to_int_impl,logical) | ||
export(to_int) | ||
import(vctrs) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,66 @@ | ||
.return_if_clear <- function(x, | ||
to, | ||
allow_empty, | ||
allow_na, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
.check_na(x = x, to = to, allow_na = allow_na, x_arg = x_arg, call = call) | ||
# .check_empty(x, allow_empty, x_arg, call) | ||
return(x) | ||
} | ||
|
||
.check_na <- function(x, | ||
to, | ||
allow_na, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
if (allow_na || !any(is.na(x))) { | ||
return(invisible(NULL)) | ||
} | ||
locations <- which(is.na(x)) | ||
cli::cli_abort( | ||
c( | ||
"{.arg {x_arg}} must not contain NA values.", | ||
"*" = "NA locations: {locations}" | ||
), | ||
call = call | ||
) | ||
} | ||
|
||
.stop_incompatible <- function(x, | ||
to, | ||
failures, | ||
due_to, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
x_class <- .obj_type(x) | ||
to_class <- .obj_type(to) | ||
locations <- which(failures) | ||
cli::cli_abort( | ||
c( | ||
"{.arg {x_arg}} {.cls {x_class}} must be coercible to {.cls {to_class}}", | ||
x = "Can't convert some values due to {due_to}.", | ||
"*" = "Locations: {locations}" | ||
), | ||
call = call | ||
) | ||
} | ||
|
||
# Derived from use_standalone("r-lib/rlang", "standalone-obj-type.R") but | ||
# simplified. | ||
.obj_type <- function(x) { | ||
if (missing(x)) { | ||
return("unknown type") # nocov | ||
} | ||
|
||
# Anything with a class. | ||
if (is.object(x)) { | ||
if (inherits(x, "quosure")) { # nocov start | ||
return("quosure") | ||
} # nocov end | ||
return(class(x)[[1L]]) | ||
} | ||
|
||
# Leftovers | ||
return(typeof(x)) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,150 @@ | ||
#' Cast an argument to integer | ||
#' | ||
#' More details soon. | ||
#' | ||
#' @param x The argument to cast. | ||
#' @param allow_empty Logical; is it ok for the argument to have length 0? | ||
#' @param allow_na Logical; are NA values ok? | ||
#' @param allow_null Logical; is NULL an acceptable value? | ||
#' @param x_arg Argument name for x. The automatic value will work in most | ||
#' cases, or pass it through from higher-level functions to make error | ||
#' messages cleaner in unexported functions. | ||
#' @param call The execution environment of the call. See the `call` argument of | ||
#' `rlang::abort()` for more information. | ||
#' | ||
#' @return The argument as an integer. | ||
#' @export | ||
#' | ||
#' @examples | ||
#' to_int(1:10) | ||
#' to_int("1") | ||
#' to_int(1 + 0i) | ||
to_int <- function(x, | ||
allow_empty = TRUE, | ||
allow_na = TRUE, | ||
allow_null = TRUE, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
x_arg <- force(x_arg) | ||
x <- .to_int_impl(x, allow_null = allow_null, x_arg = x_arg, call = call) | ||
.return_if_clear( | ||
x = x, to = integer(), | ||
allow_empty = allow_empty, allow_na = allow_na, | ||
x_arg = x_arg, call = call | ||
) | ||
} | ||
|
||
.to_int_impl <- function(x, | ||
allow_null, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
UseMethod(".to_int_impl") | ||
} | ||
|
||
|
||
#' @export | ||
.to_int_impl.integer <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
return(x) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.hexmode <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
return(as.integer(x)) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.NULL <- function(x, | ||
allow_null, | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
if (allow_null) { | ||
return(NULL) | ||
} | ||
cli::cli_abort( | ||
c("{.arg {x_arg}} can't be {.cls NULL}."), | ||
call = call | ||
) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.double <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
vec_cast(x, integer(), x_arg = x_arg, call = call) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.logical <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
vec_cast(x, integer(), x_arg = x_arg, call = call) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.character <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
cast <- suppressWarnings(as.integer(x)) | ||
cast_double <- suppressWarnings(as.double(x)) | ||
x_na <- is.na(x) | ||
non_numbers <- xor(x_na, is.na(cast)) | ||
bad_precision <- cast != cast_double & !x_na | ||
failures <- non_numbers | bad_precision | ||
|
||
if (!any(failures)) { | ||
return(cast) | ||
} | ||
|
||
if (any(non_numbers)) { | ||
.stop_incompatible( | ||
x, integer(), non_numbers, due_to = "incompatible values", x_arg, call | ||
) | ||
} | ||
|
||
.stop_incompatible( | ||
x, integer(), bad_precision, due_to = "loss of precision", x_arg, call | ||
) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.factor <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
return( | ||
.to_int_impl(as.character(x), ..., x_arg = x_arg, call = call) | ||
) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.complex <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
cast <- suppressWarnings(as.integer(x)) | ||
x_na <- is.na(x) | ||
failures <- (cast != x & !x_na) | xor(x_na, is.na(cast)) | ||
if (!any(failures)) { | ||
return(cast) | ||
} | ||
.stop_incompatible( | ||
x, integer(), failures, due_to = "non-zero complex components", x_arg, call | ||
) | ||
} | ||
|
||
#' @export | ||
.to_int_impl.default <- function(x, | ||
..., | ||
x_arg = rlang::caller_arg(x), | ||
call = rlang::caller_env()) { | ||
vec_cast(x, integer(), x_arg = x_arg, call = call) | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -2,5 +2,6 @@ | |
"_PACKAGE" | ||
|
||
## usethis namespace: start | ||
#' @import vctrs | ||
## usethis namespace: end | ||
NULL |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.