How to evaluate an expression with variables in R? - r

I expect this code to set plt equal to 10:
> var = "plt"
> eval(paste0(var, "<-", 10))
[1] "plt<-10"
But instead, it returns a string.
I tried eval(as.expression(paste0(var, "<-", 10))) and other options, but it still doesn't give the expected result.
What's wrong with the code?

If I understand your comment correctly there is no reason to dive into the shark-infested waters of eval(parse()). Try something like this instead:
myfun <- function(x, fun) {
if (is.character(fun)) fun <- match.fun(fun)
fun(x)
}
myfun(1:5, mean)
#[1] 3
myfun(1:5, "mean")
#[1] 3

See: ?parse. Your demo code:
> var = "plt"
> eval(parse(text = paste0(var, "<-", 10)))
> plt
[1] 10
Update: based on #Anton's comment about the original goal - what about:
> f <- function(type, ...) {
+ assign('plt', do.call(deparse(substitute(type)), list(...)), envir = .GlobalEnv)
+ }
> f(mean, x = 1:20)
> plt
[1] 10.5
PS: I still trying to implement what the OP is after, not what he might or should be after -- that's why I used above assign and .GlobalEnv, although it's not a great idea BTW.

Related

Can an R function behaiviour change depending of number of arguments received?

So far I have created a function that can change its behaiviour depending on whether it receives a number or a character as input, a minumal example could be the following:
...
f <- function(x)
UseMethod("g")
f.numeric <- function(x)
return(x^2)
f.character <- function(x)
return("Hey, dude. WTF are you doing? Don't give me characters!")
...
Now assume that I want f to be able to receive two numbers as input and return its sum, without losing the previous functionality. How can I achieve that?.
Could rewrite the function to do the checks yourself? e.g...
f <- function(x, y=NA){
if (all(is.numeric(c(x,y))) & !is.na(y)){
return(x+y)
}else if(is.numeric(x)){
return(x^2)
}else if(is.character(x)){
return("Hey, dude. WTF are you doing? Don't give me characters!")
}else{
return("Hey, dude. I don't know what you are giving me?!")
}
}
With ellipsis this is easily possible:
f <- function(x,...)
{
if(missing(...))
{
if(is.numeric(x)) return(x^2)
if(is.character(x)) return("Hey, dude. WTF are you doing? Don't give me characters!")
}else
{
if(any(is.character(c(x,...))) return("Hey, dude. WTF are you doing? Don't give me characters!"))
return(x+..1)
}
}
> f("foo")
[1] "Hey, dude. WTF are you doing? Don't give me characters!"
> f(4)
[1] 16
> f(4,5)
[1] 9
Not sure if this is what you need, but maybe it helps :)
sum_them <- function(var1, var2, na.rm = F)
{
if(all(is.numeric(c(var1, var2)))) return(sum(c(var1, var2), na.rm = na.rm))
return("non numeric argument")
}
sum_them("test", "this")
sum_them("test", 10)
sum_them(5, "this")
sum_them(5, 10)
sum_them(NA, 10)
sum_them(NA, 10, na.rm = T)
Output
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
Updated function, since i didn't get the do something different if it is just 1 number.
Logic behind:
if there is just 1 paramter (var1) do whatever you like whit it, but trycatch in case it is a no nummeric.
If all param are numeric, sum them up.
else return some string.
sum_them <- function(var1, ..., na.rm = F)
{
if(missing(...)) tryCatch({var1 <- var1^2}, warning = function(w){}, error = function(e){})
if(all(is.numeric(c(var1, ...)))) return(sum(c(var1, ...), na.rm = na.rm))
return("non numeric argument")
}
new output:
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
> sum_them(NA, na.rm = T)
[1] 0
> sum_them(10, na.rm = T)
[1] 100
> sum_them(10)
[1] 100
> sum_them("test")
[1] "non numeric argument"
> sum_them(10,10,10,10, NA)
[1] NA
> sum_them(10,10,10,10, NA, na.rm = T)
[1] 40
> sum_them(10,10,10,test, NA, na.rm = T)
[1] "non numeric argument"
If what you're looking for is something like C's method signatures[1], then no, I'm not aware that R has anything of that nature.
The closest I'm aware of in R is that you have a "super-function" that accepts all of the arguments and then a set of sub-functions to which the super-function distributes. For example, consider (what I've outlined below isn't functionally different than Julian_Hn's answer. The difference between using ellipses and explicitly naming the arguments is the amount of control over what they user can pass to the function. If you use ellipses, your test for the existence of the argument will look different)
super_function <- function(x = NULL, y = NULL){
if (!is.null(x) & is.null(y)){
if (is.character(x)){
sub_function_xchar(x)
} else if {
(is.numeric(x)){
sub_function_xnum(x)
}
} else {
sub_function_xelse(x)
}
} else {
if (!is.null(x) & !is.null(y)){
if (is.character(x) & is.character(y)){
sub_function_xychar(x, y)
} else {
# Okay, I think you might get the point now
}
}
}
}
sub_function_xchar <- function(x){
# whatever you want to do with x as a character
}
sub_function_xnum <- function(x){
# whatever you want to do with x as a numeric
}
sub_function_xelse <- function(x){
# whatever you want to do with any other class of x
}
sub_function_xychar <- function(x, y){
# whatever you want to do with x and y as characters
}
Yes, it's messy. I've used approaches like this with success for small sets of arguments. I don't know that I'd recommend it for large sets of arguments. Instead, if you have a lot of arguments, I'd recommend finding ways to break whatever task you're intending into smaller chunks that can each be isolated to their own functions.
[1] Not sure if I got the term right, but the functionality in C that many methods may have the same name, but they must be unique on the collection and type of arguments they accept.
If you want to keep using S3 you could use ...length() (>= R 3.4.2) :
f <- function(...)
UseMethod("f")
f.numeric <- function(...)
if(...length() == 1) ..1^2 else sum(...)
f.character <- function(...)
return("Hey, dude. WTF are you doing? Don't give me characters!")
f(2)
#[1] 4
f(3,4)
# [1] 7

Test if arguments match a function in R

Given a list of arguments, and a function, I'd like to see if I have a valid function call.
My attempt so far:
args_match <- function (fun, ...) {
fun_name <- deparse(substitute(fun))
safe_mc <- purrr::safely(match.call)
x <- safe_mc(fun, do.call(call, list(fun_name, ...)))
return(is.null(x$error))
}
This works for some functions:
> args_match(fivenum, y = 1:10)
[1] FALSE
> args_match(fivenum, x = 1:10)
[1] TRUE
But it fails for functions with a ... argument:
> args_match(mean, x = 1:10)
[1] TRUE
> args_match(mean, y = 1:10)
[1] TRUE
> mean(y = 1:10)
Error in mean.default(y = 1:10) :
argument "x" is missing, with no default
Is there a way to improve on this? The answer may be no, because some R functions indeed don't care if their arguments are missing... :-/

Can I avoid the `eval(parse())` defining a function with `polynomial()` in R?

I want to avoid using parse() in a function definition that contains a polynomial().
My polynomial is this:
library(polynom)
polynomial(c(1, 2))
# 1 + 2*x
I want to create a function which uses this polynomial expression as in:
my.function <- function(x) magic(polynomial(c(1, 2)))
where for magic(), I have tried various combinations of expression(), formula(), eval(), as.character(), etc... but nothing seems to work.
My only working solution is using eval(parse()):
eval(parse(text = paste0('poly_function <- function(x) ', polynomial(c(1, 2)))))
poly_function(x = 10)
# 21
Is there a better way to do want I want? Can I avoid the eval(parse())?
Like you, I though that the polynomial function was returning an R expression, but we were both wrong. Reading the help Index for package:polynom would have helped us both:
str(pol)
#Class 'polynomial' num [1:2] 1 2
help(pac=polynom)
So user20650 is correct and:
> poly_function <- as.function(pol)
> poly_function(10)
[1] 21
So this was how the authors (Venables, Hornick, Maechler) do it:
> getAnywhere(as.function.polynomial)
A single object matching ‘as.function.polynomial’ was found
It was found in the following places
registered S3 method for as.function from namespace polynom
namespace:polynom
with value
function (x, ...)
{
a <- rev(coef(x))
w <- as.name("w")
v <- as.name("x")
ex <- call("{", call("<-", w, 0))
for (i in seq_along(a)) {
ex[[i + 2]] <- call("<-", w, call("+", a[1], call("*",
v, w)))
a <- a[-1]
}
ex[[length(ex) + 1]] <- w
f <- function(x) NULL
body(f) <- ex
f
}
<environment: namespace:polynom>
Since you mention in your comments that getAnywhere was new then it also might be the case that you could gain by reviewing the "run up" to using it. If you type a function name at the console prompt, you get the code, in this case:
> as.function
function (x, ...)
UseMethod("as.function")
<bytecode: 0x7f978bff5fc8>
<environment: namespace:base>
Which is rather unhelpful until you follow it up with:
> methods(as.function)
[1] as.function.default as.function.polynomial*
see '?methods' for accessing help and source code
The asterisk at the end of the polynomial version tells you that the code is not "exported", i.e. available at the console just by typing. So you need to pry it out of a loaded namespace with getAnywhere.
It seems like you could easily write your own function too
poly_function = function(x, p){
sum(sapply(1:length(p), function(i) p[i]*x^(i-1)))
}
# As 42- mentioned in comment to this answer,
# it appears that p can be either a vector or a polynomial
pol = polynomial(c(1, 2))
poly_function(x = 10, p = pol)
#[1] 21
#OR
poly_function(x = 10, p = c(1,2))
#[1] 21

Writing a function with arguments that indicate what function to apply

Is there a way to write a function in which one of the arguments indicates what function to apply?
For example, if I have a function:
mf = function(data, option, level)
where I want option to tell whether to calculate the mean, median or sd of a data set?
Yes, one option is to just pass a function to option. E.g.
mf <- function(data, option) {
option <- match.fun(option)
option(data)
}
set.seed(42)
dat <- rnorm(10)
mf(dat, option = mean)
Which gives:
> set.seed(42)
> dat <- rnorm(10)
> mean(dat)
[1] 0.5472968
> mf(dat, option = mean)
[1] 0.5472968
> sd(dat)
[1] 0.8354488
> mf(dat, option = sd)
[1] 0.8354488
match.fun() is the standard R way of matching to an available function. In the example I pass the function itself, but match.fun() allows other ways of referring to a function, for example as a character string:
> mf(dat, option = "mean")
[1] 0.5472968
match.fun() returns a function that can be used as any other function, hence option() is a function that is essentially the same as the function passed to the option argument or is the function named in the option argument.
It isn't clear how the level argument was supposed to be used to I have ignored that above.
I should probably add that if you want to pass in any arguments to the applied function then you'll want to use ... in the function definition, e.g.:
mf <- function(data, option, ...) {
option <- match.fun(option)
option(data, ...)
}
Hence we can do things like this
set.seed(42)
dat2 <- rnorm(10)
dat2[4] <- NA
mean(dat2)
mean(dat2, na.rm = TRUE)
mf(dat2, mean, na.rm = TRUE)
the last three lines giving
> mean(dat2)
[1] NA
> mean(dat2, na.rm = TRUE)
[1] 0.5377895
> mf(dat2, mean, na.rm = TRUE)
[1] 0.5377895
There is a bit of a problem in that "data set" in R usually means a dataframe and there is no median.data.frame so you need to use both lapply and do.call:
df <- data.frame(x=rnorm(10), y=rnorm(10))
mf = function(data, option="mean") {lapply( data,
function(col) do.call(option, list(col))) }
mf(df)
#-------------
$x
[1] 0.01646814
$y
[1] 0.5388518
You did not indicate what "level" was supposed to do, so I left it out of the equation,
> mf(df, sd)
$x
[1] 1.169847
$y
[1] 0.8907117

Using "..." and "replicate"

In the documentation of sapply and replicate there is a warning regarding using ...
Now, I can accept it as such, but would like to understand what is behind it. So I've created this little contrived example:
innerfunction<-function(x, extrapar1=0, extrapar2=extrapar1)
{
cat("x:", x, ", xp1:", extrapar1, ", xp2:", extrapar2, "\n")
}
middlefunction<-function(x,...)
{
innerfunction(x,...)
}
outerfunction<-function(x, ...)
{
cat("Run middle function:\n")
replicate(2, middlefunction(x,...))
cat("Run inner function:\n")
replicate(2, innerfunction(x,...))
}
outerfunction(1,2,3)
outerfunction(1,extrapar1=2,3)
outerfunction(1,extrapar1=2,extrapar2=3)
Perhaps I've done something obvious horribly wrong, but I find the result of this rather upsetting. So can anyone explain to me why, in all of the above calls to outerfunction, I get this output:
Run middle function:
x: 1 , xp1: 0 , xp2: 0
x: 1 , xp1: 0 , xp2: 0
Run inner function:
x: 1 , xp1: 0 , xp2: 0
x: 1 , xp1: 0 , xp2: 0
Like I said: the docs seem to warn for this, but I do not see why this is so.
?replicate, in the Examples section, tells us explicitly that what you are trying to do does not and will not work. In the Note section of ?replicate we have:
If ‘expr’ is a function call, be aware of assumptions about where
it is evaluated, and in particular what ‘...’ might refer to. You
can pass additional named arguments to a function call as
additional named arguments to ‘replicate’: see ‘Examples’.
And if we look at Examples, we see:
## use of replicate() with parameters:
foo <- function(x=1, y=2) c(x,y)
# does not work: bar <- function(n, ...) replicate(n, foo(...))
bar <- function(n, x) replicate(n, foo(x=x))
bar(5, x=3)
My reading of the docs is that they do far more than warn you about using ... in replicate() calls; they explicitly document that it does not work. Much of the discussion in that help file relates to the ... argument of the other functions, not necessarily to replicate().
If you look at the code for replicate:
> replicate
function (n, expr, simplify = TRUE)
sapply(integer(n), eval.parent(substitute(function(...) expr)),
simplify = simplify)
<environment: namespace:base>
You see that the function is evaluated in the parent frame, where the ... from your calling function no longer exists.
There actually is a way to do this:
# Simple function:
ff <- function(a,b) print(a+b)
# This will NOT work:
testf <- function(...) {
replicate(expr = ff(...), n = 5)
}
testf(45,56) # argument "b" is missing, with no default
# This will:
testf <- function(...) {
args <- as.list(substitute(list(...)))[-1L]
replicate(expr = do.call(ff, args), n = 5)
}
testf(45,56) # 101
An alternative way to do that:
g <- function(x, y) x + y
f <- function(a = 1, ...) {
arg_list <- list(...)
replicate(n = 3, expr = do.call(g, args = arg_list))
}
f(x = 1, y = 2)

Resources