I would like to use the calculations from high-level (outer) function high_lvl_fun in in a low-level (inner) function low_lvl_fun. The low-level function is an argument of the high-level one (I would like to use different functions with different sets of arguments). My reproducible example:
set.seed(101)
low_lvl_fun <- function(x, y){ # low-level (inner) function
sum((x-y)^2) # Mean Squared Error
}
high_lvl_fun <- function(x, y = NULL, FUN, args){ # high level (outer) function
# Just some toy changes in y to check if the code works
if(length(y) == 0){
y <- rep(1, length(x))
}else{
y <- rep(2, length(x))
}
do.call(FUN, args = args) # Call of low_lvl_fun
}
The low-level function computes Mean Squared Error. The high-level function performs some operations on vector y and calls the low-level function. Declaration of such an argument and the high-level function call:
x <- rnorm(100)
high_lvl_fun(x, y = NULL, FUN = "low_lvl_fun", args = list(x, y))
results in such an error:
Error in do.call(FUN, args = args) : object 'y' not found
I understand that the low-level function assumes that the value of y is NULL (as declared in high-level function call), however, I don't know how to change the scope in which the low-level function searches for y.
The only solution I came up with would be to declare y in the global environment:
high_lvl_fun2 <- function(x, y = NULL, FUN, args){ # high level (outer) function
if(length(y) == 0){
y <<- rep(1, length(x))
}else{
y <<- rep(2, length(x))
}
do.call(FUN, args = args) # Call of low_lvl_fun
}
however, I would like to avoid modifying y in the global environment.
EDIT: (more details)
The low-level function can take arguments other than x and y. It may also require only x and other arguments, and not y, for example:
low_lvl_fun2 <- function(x){sd(x)/mean(x)}
The other important thing is that high and low-level functions can have the arguments with the same names (like above, where both functions have arguments called x and y) and it would be good not being forced to rewrite low-level function. Unfortunately, the implementation in the comments suggested by #Andrea does not meet this condition, since matching two arguments with the same names throws an error:
high_lvl_fun <- function(x, y = NULL, FUN, ...){ # Function suggested by #Andrea
dots <- lazy_eval(lazy_dots(...))
# Just some toy changes in y to check if the code works
if(length(y) == 0){
y <- rep(1, length(x))
}else{
y <- rep(2, length(x))
}
args <- c(list(x , y) , dots)
do.call(FUN, args = args) # Call of low_lvl_fun
}
# Calling the low-level function at the beginning of the post
high_lvl_fun(x = 1:10, y = 2:11, FUN = "low_lvl_fun", x = x, y = y)
Error in high_lvl_fun(x = 1:10, y = 2:11, FUN = "low_lvl_fun", x = x,
: formal argument "x" matched by multiple actual arguments
Assuming that low_lvl_fun() takes x and y only. This should do the job
high_lvl_fun <- function(x, y = NULL, FUN ){ # high level (outer) function
# Just some toy changes in y to check if the code works
if(length(y) == 0){
y <- rep(1, length(x))
}else{
y <- rep(2, length(x))
}
args <- list(x = x, y = y)
do.call(FUN, args = args) # Call of low_lvl_fun
}
As a more general solution I would suggest
The use of the ... argument
require(lazyeval)
high_lvl_fun <- function(x, y = NULL, FUN, ...){ # high level (outer) function
dots <- lazy_eval(lazy_dots(...))
# Just some toy changes in y to check if the code works
y <- y+1
args <- c(list(x , y) , dots)
do.call(FUN, args = args) # Call of low_lvl_fun
}
# Ex 1
f <- function(x, y , z) {x+y+z}
high_lvl_fun (x = 1, y = 2, FUN = f, z = 3)
# Ex 2
g <- function(x, y , z, mean , sd) {
n <- x+y+z
sum(rnorm(n , mean , sd))
}
high_lvl_fun (x = 1, y = 2, FUN = g, z = 3, mean = 100, sd = 1)
Related
I have a global function of roughly the form:
demo_fcn <- function(f, x1,x2){
r = x1 - x2
return(f(r))
}
I want to create this function in a general way so that users can add their own f with their own custom inputs, so long as there is an input slot for r. Say we take f to be the following function
f <- function(input, factor){
out = input^factor
return(out)
}
In this case, input = r, so that the user is able to call
demo_fcn(f(factor=2),x1=2,x2=3)
I get the error
Error in f(factor = 2) : argument "input" is missing, with no default
The desired outcome here should be the following code running
r = 2-3
f(input=r, factor=2)
The end goal is to implement this in a more complicated function, with multiple arguments for both demo_fcn and f
demo_fcn <- function(f, x1,x2){
r1 = x1 - x2
r2 = x1+x2
return(f(r1,r2))
}
f <- function(input1, input2, factor1,factor2){
out = input^factor1 + input2^factor2
return(out)
}
One way is to pass a function (not a function call), and use ... in the top function to pass additional arguments.
demo_fcn <- function(f, x1, x2, ...) {
r = x1 - x2
f(r, ...)
}
f <- function(input, factor){
out = input^factor
out
}
demo_fcn(f, x1=2, x2=5, factor=2)
# [1] 9
If you want to have multiple such functions, then you can do:
demo_fcn <- function(f1, f2, x1, x2, f1opts = NULL) {
r = x1 - x2
do.call(f, c(list(r), f1opts))
}
demo_fcn(f, x1=2, x2=5, f1opts=list(factor=2))
Yet another alternative, taking from curve, which may match more closely what you're hoping for.
demo_fcn <- function(expr, x1, x2, xname = "x") {
r = x1 - x2
sexpr <- substitute(expr)
if (is.name(sexpr)) {
expr <- call(as.character(sexpr), as.name(xname))
} else {
if (!((is.call(sexpr) || is.expression(sexpr)) && xname %in%
all.vars(sexpr)))
stop(gettextf("'expr' must be a function, or a call or an expression containing '%s'",
xname), domain = NA)
expr <- sexpr
}
ll <- list(x = r)
names(ll) <- xname
eval(expr, envir = ll, enclos = parent.frame())
}
demo_fcn(f(x, factor=2), x1=2, x2=5)
# [1] 9
See ?curve for more explanation of xname=, but in short: use x in your call to f(.) though it does not use any object named x in the local or other environment, it is just a placeholder. If you prefer, you can change to xname="input" and demo_fcn(f(input,factor=2),...) for the same effect, but realize that in that call, input is still a placeholder, not a reference to an object.
So I want to pass the output of func1 to func2.
func1 <- function(x, y, z) {
k = x*2
j = y*2
i = z*2
}
func2 <- function(x, y, z) {
func1(x, y, z)
m = k * j * i
return (m)
}
It keeps printing errors.
Here is another solution. This is called a function factory which means a function that creates another function. Since func2 only uses the outputs of func1, it can find them through lexical scoping in its parent environment which is the execution environment of func1.
Just note the additional pair of parentheses I used in order to call the function since the output of the first function is a function.
func1 <- function(x, y, z) {
k <- x * 2
j <- y * 2
i <- z * 2
func2 <- function() {
m <- k * j * i
m
}
}
func1(1, 2, 3)()
[1] 48
For more information you can read this section of Hadley Wickham's Advanced R.
There are quite a few things going on here, and it really partly depends on if you are showing us a very simplified version. For example, are you really doing the same thing to x, y, z in the first function or are you possibly doing different things?
First, the i, j and k vectors that you are creating in func1() do not exist outside of func1().
As #akrun said you could rectify this bye making them into a vector (if they are always of the same type) or a list and then returning that.
So then you could get, say,
func1 <- function(x, y, z) {
k <- x*2
j <- y*2
i <- z*2
c(k, j, i)
}
At which point you could a a parameter to your second function.
func2 <- function(x, y, z) {
ijk <- func1(x, y, z)
prod(ijk)
}
Of course even easier if you can vectorize func1() (but I don't know how much you simplified).
func1v2 <- function(x, y, z) {
2* c(k, j, i)
}
We may return a named list from the first function and then access the names of the output of the first function using with
func1 <- function(x, y, z) {
list(k = x*2,
j = y*2,
i = z*2)
}
func2 <- function(x, y, z) {
with(func1(x, y, z), k * j * i)
}
-testing
func2(3, 5, 6)
Since func2 only makes the product of a vector you do not need to define a second function. You can do it like this: First define func1 as you did
func1 <- function(x, y, z) {
k = x*2
j = y*2
i = z*2
return(c(k,j,i))
}
Then use it inside the prod function like this
prod(func1(1, 2, 3))
48
I am trying to create new functions from a list of function and a list of parameters to be passed to these functions, but am unable to do so so far. Please see the example below.
fun_list <- list(f = function(x, params) {x+params[1]},
z = function(a, params) {a * params[1] * params[2]})
params_list <- list(f = 1, z = c(3, 5))
# goal is to create 2 new functions in global environment
# fnew <- function(x) {x+1}
# znew <- function(a) {a*3*5}
# I've tried
for(x in names(fun_list)){
force(x)
assign(paste0(x, "new"), function(...) fun_list[[x]] (..., params = params_list[[x]]))
}
The goal is to do this dynamically for arbitrary functions and parameters.
Well, force() doesn't work in a for-loop because for loops do not create new environments. Based on a previous question of mine, I created a capture() function
capture <- function(...) {
vars <- sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
this allows
for(x in names(fun_list)) {
f = local({
capture(x);
p = params_list[[x]];
f = fun_list[[x]];
function(x) f(x, p)
})
assign(paste0(x, "new"), f)
}
where we create a local, private environment for the functions to store their default parameter values.
Which gives
fnew(2)
# [1] 3
znew(2)
# [1] 30
How about this:
for(x in names(fun_list)) {
formals(fun_list[[x]])$params <- params_list[[x]]
assign(paste0(x, "new"), fun_list[[x]])
}
This is similar in spirit:
ps <- list(fp=1,zp=c(3,5))
f0s <- substitute(list(f=function(x)x+fp,z=function(a)a*zp1*zp2),as.list(unlist(ps)))
f0s # list(f = function(x) x + 1, z = function(a) a * 3 * 5)
fs <- eval(f0s)
fs$f(1) # 2
To do the fancy thing described in the OP, you'd probably have to mess with formals.
Is there a way to make mutate() evaluate formulas in (d)plyr package of R? I think of situations where one has many variables like count.a, count.b, ..., count.z and I would like to create a new variable to sum all these. I can create a character string like "count.total = count.a + count.b + (...) + count.z", but how to make mutate() evaluate it?
If you want expression input
library(dplyr)
df = data.frame(x = 1:10, y = 2:11)
f = function(df, s){
eval(substitute(mutate(df, z = s)))
}
f(df, x-y)
f(df, x+y)
If you want character input
g = function(df, s){
q = quote(mutate(df, z = s))
eval(parse(text=sub("s", s, deparse(q))))
}
g(df, "x-y")
g(df, "x+y")
You can also modify the functions to take the name of z as an input.
Expression input: f1 passes all extra parameters to mutate, f2 only passes one argument to mutate.
f1 = function(df, ...){
mutate(df, ...)
}
f1(df, a = x-y)
f2 = function(df, ...){
dots = substitute(alist(...))
var = names(dots)[2]
cal = as.call(list(quote(mutate), quote(df)))
cal[var] = dots[2]
eval(cal)
}
f2(df, a = x-y)
Again, if you want to use character input
g1 = function(df, s){
q = quote(mutate(df, z = s))
eval(parse(text=sub("z = s", s, deparse(q))))
}
g1(df, "a=x-y")
g1(df, "w=x+y")
Consider the following example:
q1.func <- function(x) {
num <- (cos(30.2 * x^(1/2)))^2
denom <- (x^0.7) * exp(0.9*x)
num / denom
}
method1 <- function(n) {
x <- runif(n,min = 0, max = 1.7)
f <- q1.func(x)
(1.7) * sum((1/n) * f)
}
draw.graph <- function() {
n <- seq(1,1000,1)
x <- c()
for(i in 1:length(n)) {
x <- append(x, method1(n[i]))
}
plot(n, x, type = "p", xlab = "N",ylab = "value" ,main = "method1 plot",col = "black")
}
My point is that I want to be able to perform: draw.graph(method1(n)). But R wouldnt allow me to do that. I dont understand why is this happening??? My ultimate goal is that I would be able to pass method2 / method3 /.... as argument of draw.graph() function. But how??? Right now, I am only interested in solutions that allow me to pass method1 as an argument of the draw.graph function. Please dont ask me to write method1 WITHIN the draw.graph function, because I already know that it works. But I am more interested in passing method1 as an argument of the draw.graph function. Thanks
I'll make a simpler example to illustrate the main point (there are other issues with the code you proposed).
fun1 = function(x) cos(x)
fun2 = function(x) sin(x)
# function where one argument is a function
wrapper = function(a = 2, fun = fun1){
x = 1:10
return(data.frame(x = x, y = a*fun(x)))
}
# testing behaviour
wrapper()
wrapper(fun = fun2)
Your draw.graph function lacks an argument.
Why not simply use the return value of an function as argument of the next function?
draw.graph <- function(y) {
plot(seq_along(y), y)
}
method1 <- function(n) {
return(runif(n, min=0, max=1.7))
}
draw.graph(method1(100))
If you really need a function as argument you could try the following (please read ?match.fun):
## stupid example
calc <- function(x, fun) {
fun <- match.fun(fun)
return(fun(x))
}
calc(1:10, sum)
EDIT:
To fulfill the OP question/comments I add this specific example:
q1.func <- function(x) {
num <- cos(30.2 * sqrt(x))^2
denom <- x^0.7 * exp(0.9*x)
return(num/denom)
}
method1 <- function(n) {
x <- runif(n, min=0, max=1.7)
return(1.7*sum(1/n*q1.func(x)))
}
draw.graph <- function(n, fun) {
fun <- match.fun(fun)
y <- unlist(lapply(n, fun))
plot(n, y)
}
draw.graph(1:1000, method1)