Search code examples
rrlang

Using rlang's arg_match for checking a list of function inputs


I am trying to quickly check a list of arguments for a function that each take a vector of strict values. I can do this one at a time:

fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  rlang::arg_match(x)
  rlang::arg_match(y)
}

fn(x = "bar", y = "bar")
# [1] "bar"
fn(x = "baz", y = "baz")
# Error in `fn()`:
# ! `x` must be one of "foo" or "bar", not "baz".
# ℹ Did you mean "bar"?
# Run `rlang::last_trace()` to see where the error occurred.
fn(x = "bar", y = "foo")
# Error in `fn()`:
# ! `y` must be one of "bar" or "baz", not "foo".
# Run `rlang::last_trace()` to see where the error occurred.fn(x = "baz", y = "baz")

But when I try to combine them with lapply, the variables are passed as calls not symbols.

fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  lapply(c(x, y), function(i) rlang::arg_match(enquo(i)))
}
fn(x = "bar", y = "bar")
# Error in `rlang::arg_match()`:
# ! `arg` must be a symbol, not a call.
# Run `rlang::last_trace()` to see where the error occurred.
fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  lapply(c("x", "y"), function(i) rlang::arg_match(get(i)))
}
fn(x = "bar", y = "bar")
# Error in `rlang::arg_match()`:
# ! `arg` must be a symbol, not a call.
# Run `rlang::last_trace()` to see where the error occurred.
fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  lapply(c("x", "y"), function(i) rlang::arg_match(eval(i)))
}
fn(x = "bar", y = "bar")
# Error in `rlang::arg_match()`:
# ! `arg` must be a symbol, not a call.
# Run `rlang::last_trace()` to see where the error occurred.
fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  lapply(c("x", "y"), function(i) rlang::arg_match({{ i }}))
}
fn(x = "bar", y = "bar")
# Error in switch(type, call = "prefix", control = , delim = , subset = "special",  :
#   EXPR must be a length 1 vector
fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
  lapply(c(x, y), function(i) rlang::arg_match({{ i }}))
}
fn(x = "bar", y = "bar")
# Error in switch(type, call = "prefix", control = , delim = , subset = "special",  :
#   EXPR must be a length 1 vector

How do I pass them in without calling them? Or is there a more efficient way to verify a subset of arguments each have an acceptable value?


Solution

  • Neither rlang::arg_match nor base::match.arg work well in an lapply because the function context changes.

    You could get around parts using a for loop with some eval nonsense

    fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
      for(v in c("x", "y")) {
        eval(rlang::expr(rlang::arg_match(!!(rlang::sym(v)))))
      }
    }
    

    Or you could just roll your own checker

    fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
      for(v in c("x", "y")) {
        expected <- eval(formals(sys.function())[[v]])
        if (!get(v) %in% expected) stop(paste0("'", v, "' must be one of ", toString(sQuote(expected, F)), " not '", get(v), "'"))
      }
    }
    

    A more generic solution would be a helper like

    check_vars <- function(vars, env = parent.frame(), fn = sys.function(1)) {
      if (any(!vars %in% names(formals(fn)))) {
        message("cannot check values for: ", toString(vars[!vars %in% names(formals(fn))]))
        vars <- intersect(vars, names(formals(fn)))
      }
      expected <- lapply(formals(fn)[vars], rlang::eval_bare)
      for(v in vars) {
        obs <- get(v, envir=env)
        if (!obs %in% expected[[v]]) {
          stop(paste0("'", v, "' must be one of ", toString(sQuote(expected[[v]], F)), " not '", obs, "'"), call.=F)
        }
      }
    }
    

    Which you could reuse in multiple functions with

    fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
      check_vars(c("x", "y"))
    }
    

    Out helper function allows us to explicitly pass in the function environment and the calling function. This would allow us to override either as necessary. Which means you could use it with lapply

    fn <- function(x = c("foo", "bar"), y = c("bar", "baz")) {
      lapply(c("x", "y"), check_vars, env=environment(), fn=sys.function(1))
    }