if (FALSE) {
dlog <- function(x, h) (log(x + h) - log(x)) / h
# Require all arguments to be numeric (auto-generated error message)
dlog_fm <- firmly(dlog, ~is.numeric)
dlog_fm(1, .1) # [1] 0.9531018
dlog_fm("1", .1) # Error: "FALSE: is.numeric(x)"
# Require all arguments to be numeric (custom error message)
dlog_fm <- firmly(dlog, "Not numeric" ~ is.numeric)
dlog_fm("1", .1) # Error: "Not numeric: `x`"
# Alternatively, "globalize" a localized checker (see ?localize, ?globalize)
dlog_fm <- firmly(dlog, globalize(vld_numeric))
dlog_fm("1", .1) # Error: "Not double/integer: `x`"
# Predicate functions can be specified anonymously or by name
dlog_fm <- firmly(dlog, list(~x, ~x + h, ~abs(h)) ~ function(x) x > 0)
dlog_fm <- firmly(dlog, list(~x, ~x + h, ~abs(h)) ~ {. > 0})
is_positive <- function(x) x > 0
dlog_fm <- firmly(dlog, list(~x, ~x + h, ~abs(h)) ~ is_positive)
dlog_fm(1, 0) # Error: "FALSE: is_positive(abs(h))"
# Describe checks individually using custom error messages
dlog_fm <-
firmly(dlog,
list("x not positive" ~ x, ~x + h, "Division by 0 (=h)" ~ abs(h)) ~
is_positive)
dlog_fm(-1, 0)
# Errors: "x not positive", "FALSE: is_positive(x + h)", "Division by 0 (=h)"
# Specify checks more succinctly by using a (localized) custom checker
req_positive <- localize("Not positive" ~ is_positive)
dlog_fm <- firmly(dlog, req_positive(~x, ~x + h, ~abs(h)))
dlog_fm(1, 0) # Error: "Not positive: abs(h)"
# Combine multiple checks
dlog_fm <- firmly(dlog,
"Not numeric" ~ is.numeric,
list(~x, ~x + h, "Division by 0" ~ abs(h)) ~ {. > 0})
dlog_fm("1", 0) # Errors: "Not numeric: `x`", check-eval error, "Division by 0"
# Any check can be expressed using isTRUE
err_msg <- "x, h differ in length"
dlog_fm <- firmly(dlog, list(err_msg ~ length(x) - length(h)) ~ {. == 0L})
dlog_fm(1:2, 0:2) # Error: "x, h differ in length"
dlog_fm <- firmly(dlog, list(err_msg ~ length(x) == length(h)) ~ isTRUE)
dlog_fm(1:2, 0:2) # Error: "x, h differ in length"
# More succinctly, use vld_true
dlog_fm <- firmly(dlog, vld_true(~length(x) == length(h), ~all(abs(h) > 0)))
dlog_fm(1:2, 0:2)
# Errors: "Not TRUE: length(x) == length(h)", "Not TRUE: all(abs(h) > 0)"
dlog_fm(1:2, 1:2) # [1] 0.6931472 0.3465736
# loosely recovers the underlying function
identical(loosely(dlog_fm), dlog) # [1] TRUE
# Use .warn_missing when you want to ensure an argument is explicitly given
# (see vignette("valaddin") for an elaboration of this particular example)
as_POSIXct <- firmly(as.POSIXct, .warn_missing = "tz")
Sys.setenv(TZ = "EST")
as_POSIXct("2017-01-01 03:14:16") # [1] "2017-01-01 03:14:16 EST"
# Warning: "Argument(s) expected ... `tz`"
as_POSIXct("2017-01-01 03:14:16", tz = "UTC") # [1] "2017-01-01 03:14:16 UTC"
loosely(as_POSIXct)("2017-01-01 03:14:16") # [1] "2017-01-01 03:14:16 EST"
# Use firmly to constrain undesirable behavior, e.g., long-running computations
fib <- function(n) {
if (n <= 1L) return(1L)
Recall(n - 1) + Recall(n - 2)
}
fib <- firmly(fib, list("`n` capped at 30" ~ ceiling(n)) ~ {. <= 30L})
fib(21) # [1] 17711 (NB: Validation done only once, not for every recursive call)
fib(31) # Error: `n` capped at 30
# Apply fib unrestricted
loosely(fib)(31) # [1] 2178309 (may take several seconds to finish)
# firmly won't force an argument that's not involved in checks
g <- firmly(function(x, y) "Pass", list(~x) ~ is.character)
g(c("a", "b"), stop("Not signaled")) # [1] "Pass"
# In scripts and packages, it is recommended to use the operator %checkin%
vec_add <- list(
~is.numeric,
list(~length(x) == length(y)) ~ isTRUE,
.error_class = "inputError"
) %checkin%
function(x, y) {
x + y
}
# Or call firmly with .f explicitly assigned to the function
vec_add2 <- firmly(
~is.numeric,
list(~length(x) == length(y)) ~ isTRUE,
.f = function(x, y) {
x + y
},
.error_class = "inputError"
)
all.equal(vec_add, vec_add2) # [1] TRUE
}
Run the code above in your browser using DataLab