I can't quite follow the logic of match.fun
faux <- function (FUN, descend = TRUE)
{
if (is.function(FUN))
return(FUN)
if (!(is.character(FUN) && length(FUN) == 1L || is.symbol(FUN))) {
FUN <- eval.parent(substitute(substitute(FUN)))
if (!is.symbol(FUN))
stop(gettextf("'%s' is not a function, character or symbol",
deparse(FUN)), domain = NA)
}
envir <- parent.frame(2)
if (descend)
FUN <- get(as.character(FUN), mode = "function", envir = envir)
else {
FUN <- get(as.character(FUN), mode = "any", envir = envir)
if (!is.function(FUN))
stop(gettextf("found non-function '%s'", FUN), domain = NA)
}
return(FUN)
}
FUN <- function(x) mean(x, na.rm = TRUE)
faux(FUN)
#> function(x) mean(x, na.rm = TRUE)
!(is.character(FUN) && length(FUN) == 1L || is.symbol(FUN))
#> [1] TRUE
eval.parent(substitute(substitute(FUN)))
#> FUN
!is.symbol(eval.parent(substitute(substitute(FUN))))
#> [1] FALSE
# on to else block
FUN <- function(x) x^2
# fails with as.character(FUN)
get(as.character(FUN), mode = "any", envir = envir)
#> Error in as.character(FUN): cannot coerce type 'closure' to vector of type 'character'
Created on 2021-01-01 by the reprex package (v0.3.0.9001)