transfer character in function to the function in r - r

I have such a problem, I want to define the grad function as an input of the function. Please see the example below.
f<-function(grad="2*m-4"){
y=grad
return(y)
}
f(3)=2

I'm usually not a fan of using eval(parse(text=..)), but it does do this with a character string:
f <- function(m, grad="2*m-4"){
eval(parse(text = grad))
}
f(3)
# [1] 2
The two take-aways:
if your grad formula requires variables, you should make them arguments of your function; and
parse(text=..) parse the string as if the user typed it in to R's interpreter, and it returns an expression:
parse(text="2*m - 4")
# expression(2*m - 4)
This expression can then be evaluated with eval.

Related

Evaluating (...) in a function argument in R

I have the following functions:
ignore <- function(...) NULL
tee <- function(f, on_input = ignore, on_output = ignore) {
function(...) {
on_input(...)
output <- f(...)
on_output(output)
output
}
}
My question would be on how is the (...) expression evaluated in the on_input in the tee function? I understand that in the case of ignore function, it will simply take any arguments and still return a NULL value. However, I am unsure if on_input and on_output are functions and also on what will happen to the on_input and output function in this case?
you took that code from Wickham Book Advanced R.
In this book you can find an example
g <- function(x) cos(x) - x
zero <- uniroot(g, c(-5, 5))
show_x <- function(x, ...) cat(sprintf("%+.08f", x), "\n")
# The location where the function is evaluated:
zero <- uniroot(tee(g, on_input = show_x), c(-5, 5))
You can imagine that on_input and on_output are function that work with the input and the output of the function.
In this case for example you are printing the input of each iteration on the g function.
zero <- uniroot(tee(g, on_output = show_x), c(-5, 5))
On this case on the contrary you are printing the output of the function on each iteration.
To summarise, yes on_input and on_output are functions and this function simply work with the input and the output of the function f.
EDIT
Just an easier example to understand what is going on
pow2<-function(x){x^2}
input<-function(x){
cat(paste("input is ",x,"\n",sep=""))
}
output<-function(x){
cat(paste("output is ",x,"\n",sep=""))
}
tee(pow2,on_input=input,on_output=output)(2)
input is 2
output is 4
[1] 4
the main function here is obviously pow2
tee take pow2 and return a function that run on_input, pow2 and on_output.
Notice also that you have to call and pass an argument to the result of tee, in fact tee is returning a function and not a value
(...) match all additional arguments passed

Maximizing mathematical function which is saved as character string

I have the following problem: I'm writing a function which first constructs a long character string which stands for a mathematical function, e.g. "1/(1+exp(-x1+4x3))". I now want to maximize this function, but unfortunately I cannot do so because the mathematical function is only saved as a character string and not as an R-function. How can I solve this problem? Thanks in advance!
If we know what the arguments are ahead of time then (1) would be preferred as it is simpler (4 lines of code) but if we don't then (2) covers generating them as well (8 lines of code).
1) dynamic body This will convert the string s into a function f2 of 2 arguments which we can call from f1 having one argument as required by optim:
s <- "1/(1+exp(-x1+4*x3))" # test input
f1 <- function(x) do.call("f2", as.list(x)) # f1 calls f2
f2 <- function(x1, x3) {}
body(f2) <- parse(text = s)
optim(c(0, 0), f1, control = list(fnscale = -1))
2) dynamic body + dynamic args In the above we dynamically created the body from the string assuming we knew the arguments but if you want to dynamically create both the body and arguments then try this. Here f2 no longer necessarily has 2 arguments but has nv arguments and what they are is derived from the input s.
s <- "1/(1+exp(-x1+4*x3))" # test input - same as above
f1 <- function(x) do.call("f2", as.list(x)) # function on one argument - same as above
# f2 has nv arguments
f2 <- function() {}
p <- parse(text = s)
v <- all.vars(p) # character string of variable names used for arguments
nv <- length(v)
formals(f2) <- setNames(rep(alist(x=), nv), v)
body(f2) <- p
optim(numeric(nv), f1, control = list(fnscale = -1)) # first arg different from (1)
I'm writing a function which first constructs a long character string which stands for a mathematical function
Don't do that. I'm sure there is a better approach.
because the mathematical function is only saved as a character string and not as an R-function
You'd need to parse the string (after making it valid R syntax):
expr <- parse(text = gsub("((?<=\\d)[[:alpha:]])", "\\*\\1","1/(1+exp(-x1+4x3))", perl = TRUE))
Then you can use this expression to "find the maximum" with whatever method you'd like to use.
However, as fortune 106 says:
If the answer is parse() you should usually rethink the question.

have an object that is an equation written with sprintf evaluate in R

Say I have written the following object, an equation, eqn.r, using the sprintf command in R, that evaluates based on a vector of input, pizza:
eqn.r<- sprintf("sum((%s - mean(%s,na.rm=T))^2,na.rm=T)",pizza,pizza)
pizza<-c(1:10)
When I type eqn.r into the R console I get this:
"sum((pizza - mean(pizza,na.rm=T))^2,na.rm=T)"
I want it to actually evaluate, and print this:
> sum((pizza - mean(pizza,na.rm=T))^2,na.rm=T)
[1] 82.5
Given a variable name stored as a string, you can the variable's data from the passed data frame using standard indexing. In general, this is much preferred to generating code with something like sprintf or paste and then parsing and evaluating that code.
f <- function(dat, vname) sum((dat[,vname] - mean(dat[,vname], na.rm=T))^2, na.rm=T)
f(iris, "Sepal.Length")
# [1] 102.1683
If you wanted to invoke your function without quotes around the variable name, you could do:
f2 <- function(dat, vname) {
m <- match.call()
x <- with(eval(m[["dat"]]), eval(m[["vname"]]))
sum((x - mean(x,na.rm=T))^2,na.rm=T)
}
f2(iris, Sepal.Length)
# [1] 102.1683

from an expression to a language object

I would like to use microbenchmark::microbenchmark(), but with arguments in the ... that I programatically construct, with strings.
Example :
# classic way
microbenchmark(head(1:1e6), head(1:1e8), times = 10) # (interesting...)
# define my arguments
functionStrings <- lapply(c(6,8), function(ni) paste0("head(1:1e", ni, ")"))
# will not work
do.call(microbenchmark, lapply(functionStrings, function(vi) parse(text=vi)))
The problem here is that microbenchmark works with unevaluated expressions, of class "language", that it then deparse(). Doing deparse() on a normal expression unfortunately deparse the expression object...
bla <- quote(head(1:1e6))
blou <- parse(text = "head(1:1e6)")
eval(bla) ; eval(blou) # Same thing, but....
deparse(bla)
deparse(parse(text = "head(1:1e6)"))
How to get from a string or an expression (argument or output of parse() above) to a language object (output of quote() above) ?
The anonymous function in the last line of the first block of code should be:
function(vi) parse(text=vi)[[1]]
That is:
the argument to parse is named text and not test and
a call object is needed rather than an expression so use [[1]] .

Finding the names of all functions in an R expression

I'm trying to find the names of all the functions used in an arbitrary legal R expression, but I can't find a function that will flag the below example as a function instead of a name.
test <- expression(
this_is_a_function <- function(var1, var2){
this_is_a_function(var1-1, var2)
})
all.vars(test, functions = FALSE)
[1] "this_is_a_function" "var1" "var2"
all.vars(expr, functions = FALSE) seems to return functions declarations (f <- function(){}) in the expression, while filtering out function calls ('+'(1,2), ...).
Is there any function - in the core libraries or elsewhere - that will flag 'this_is_a_function' as a function, not a name? It needs to work on arbitrary expressions, that are syntactically legal but might not evaluate correctly (e.g '+'(1, 'duck'))
I've found similar questions, but they don't seem to contain the solution.
If clarification is needed, leave a comment below. I'm using the parser package to parse the expressions.
Edit: #Hadley
I have expressions with contain entire scripts, which usually consist of a main function containing nested function definitions, with a call to the main function at the end of the script.
Functions are all defined inside the expressions, and I don't mind if I have to include '<-' and '{', since I can easy filter them out myself.
The motivation is to take all my R scripts and gather basic statistics about how my use of functions has changed over time.
Edit: Current Solution
A Regex-based approach grabs the function definitions, combined with the method in James' comment to grab function calls. Usually works, since I never use right-hand assignment.
function_usage <- function(code_string){
# takes a script, extracts function definitions
require(stringr)
code_string <- str_replace(code_string, 'expression\\(', '')
equal_assign <- '.+[ \n]+<-[ \n]+function'
arrow_assign <- '.+[ \n]+=[ \n]+function'
function_names <- sapply(
strsplit(
str_match(code_string, equal_assign), split = '[ \n]+<-'),
function(x) x[1])
function_names <- c(function_names, sapply(
strsplit(
str_match(code_string, arrow_assign), split = '[ \n]+='),
function(x) x[1]))
return(table(function_names))
}
Short answer: is.function checks whether a variable actually holds a function. This does not work on (unevaluated) calls because they are calls. You also need to take care of masking:
mean <- mean (x)
Longer answer:
IMHO there is a big difference between the two occurences of this_is_a_function.
In the first case you'll assign a function to the variable with name this_is_a_function once you evaluate the expression. The difference is the same difference as between 2+2 and 4.
However, just finding <- function () does not guarantee that the result is a function:
f <- function (x) {x + 1} (2)
The second occurrence is syntactically a function call. You can determine from the expression that a variable called this_is_a_function which holds a function needs to exist in order for the call to evaluate properly. BUT: you don't know whether it exists from that statement alone. however, you can check whether such a variable exists, and whether it is a function.
The fact that functions are stored in variables like other types of data, too, means that in the first case you can know that the result of function () will be function and from that conclude that immediately after this expression is evaluated, the variable with name this_is_a_function will hold a function.
However, R is full of names and functions: "->" is the name of the assignment function (a variable holding the assignment function) ...
After evaluating the expression, you can verify this by is.function (this_is_a_function).
However, this is by no means the only expression that returns a function: Think of
f <- function () {g <- function (){}}
> body (f)[[2]][[3]]
function() {
}
> class (body (f)[[2]][[3]])
[1] "call"
> class (eval (body (f)[[2]][[3]]))
[1] "function"
all.vars(expr, functions = FALSE) seems to return functions declarations (f <- function(){}) in the expression, while filtering out function calls ('+'(1,2), ...).
I'd say it is the other way round: in that expression f is the variable (name) which will be asssigned the function (once the call is evaluated). + (1, 2) evaluates to a numeric. Unless you keep it from doing so.
e <- expression (1 + 2)
> e <- expression (1 + 2)
> e [[1]]
1 + 2
> e [[1]][[1]]
`+`
> class (e [[1]][[1]])
[1] "name"
> eval (e [[1]][[1]])
function (e1, e2) .Primitive("+")
> class (eval (e [[1]][[1]]))
[1] "function"
Instead of looking for function definitions, which is going to be effectively impossible to do correctly without actually evaluating the functions, it will be easier to look for function calls.
The following function recursively spiders the expression/call tree returning the names of all objects that are called like a function:
find_calls <- function(x) {
# Base case
if (!is.recursive(x)) return()
recurse <- function(x) {
sort(unique(as.character(unlist(lapply(x, find_calls)))))
}
if (is.call(x)) {
f_name <- as.character(x[[1]])
c(f_name, recurse(x[-1]))
} else {
recurse(x)
}
}
It works as expected for a simple test case:
x <- expression({
f(3, g())
h <- function(x, y) {
i()
j()
k(l())
}
})
find_calls(x)
# [1] "{" "<-" "f" "function" "g" "i" "j"
# [8] "k" "l"
Just to follow up here as I have also been dealing with this problem: I have now created a C-level function to do this using code very similar to the C implementation of all.names and all.vars in base R. It however only works with objects of type "language" i.e. function calls, not type "expression". Demonstration:
ex = quote(sum(x) + mean(y) / z)
all.names(ex)
#> [1] "+" "sum" "x" "/" "mean" "y" "z"
all.vars(ex)
#> [1] "x" "y" "z"
collapse::all_funs(ex)
#> [1] "+" "sum" "/" "mean"
Created on 2022-08-17 by the reprex package (v2.0.1)
This generalizes to arbitrarily complex nested calls.

Resources