R get argument names from function call - r

I'd like to get argument names from function call:
testFun <- function(x = 1:20, z = list(a = 1, b = 2)) x %>% sin %>% sum
getArgNames <- function(value) {
# function should return all arguments names - in this case c("x", "z")
}
arg.names <- getArgNames(testFun())
And it is important to not to evaluate function before getting argument names. Any ideas?

Using the same formalArgs suggested by #Akrun (and also in the almost duplicate Get the argument names of an R function):
getArgNames <- function(value) formalArgs(deparse(substitute(value)[[1]]))
substitute(value) quotes the input, to prevent immediate evaluation, [[1]] retrieves the function from the parsed input, deparse turns it into character (since formalArgs can take the function name as character).
getArgNames(testFun())
#[1] "x" "z"

We can use formalArgs
formalArgs(testFun)
#[1] "x" "z"
If we need to pass the parameter as executable function
library(rlang)
getArgNames <- function(value) {
v1 <- enquo(value)
args <- formalArgs(get(gsub("[()]", "", quo_name(v1))))
list(args, value)
}
getArgNames(testFun())
#[[1]]
#[1] "x" "z"
#[[2]]
#[1] 0.9982219

Related

Can I access the assignment of a function from inside that function? [duplicate]

For example, suppose I would like to be able to define a function that returned the name of the assignment variable concatenated with the first argument:
a <- add_str("b")
a
# "ab"
The function in the example above would look something like this:
add_str <- function(x) {
arg0 <- as.list(match.call())[[1]]
return(paste0(arg0, x))
}
but where the arg0 line of the function is replaced by a line that will get the name of the variable being assigned ("a") rather than the name of the function.
I've tried messing around with match.call and sys.call, but I can't get it to work. The idea here is that the assignment operator is being called on the variable and the function result, so that should be the parent call of the function call.
I think that it's not strictly possible, as other solutions explained, and the reasonable alternative is probably Yosi's answer.
However we can have fun with some ideas, starting simple and getting crazier gradually.
1 - define an infix operator that looks similar
`%<-add_str%` <- function(e1, e2) {
e2_ <- e2
e1_ <- as.character(substitute(e1))
eval.parent(substitute(e1 <- paste0(e1_,e2_)))
}
a %<-add_str% "b"
a
# "ab"
2 - Redefine := so that it makes available the name of the lhs to the rhs through a ..lhs() function
I think it's my favourite option :
`:=` <- function(lhs,rhs){
lhs_name <- as.character(substitute(lhs))
assign(lhs_name,eval(substitute(rhs)), envir = parent.frame())
lhs
}
..lhs <- function(){
eval.parent(quote(lhs_name),2)
}
add_str <- function(x){
res <- paste0(..lhs(),x)
res
}
a := add_str("b")
a
# [1] "ab"
There might be a way to redefine <- based on this, but I couldn't figure it out due to recursion issues.
3 - Use memory address dark magic to hunt lhs (if it exists)
This comes straight from: Get name of x when defining `(<-` operator
We'll need to change a bit the syntax and define the function fetch_name for this purpose, which is able to get the name of the rhs from a *<- function, where as.character(substitute(lhs)) would return "*tmp*".
fetch_name <- function(x,env = parent.frame(2)) {
all_addresses <- sapply(ls(env), pryr:::address2, env)
all_addresses <- all_addresses[names(all_addresses) != "*tmp*"]
all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)
x_address <- tracemem(x)
untracemem(x)
x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))
ind <- match(x_address_short, all_addresses_short)
x_name <- names(all_addresses)[ind]
x_name
}
`add_str<-` <- function(x,value){
x_name <- fetch_name(x)
paste0(x_name,value)
}
a <- NA
add_str(a) <- "b"
a
4- a variant of the latter, using .Last.value :
add_str <- function(value){
x_name <- fetch_name(.Last.value)
assign(x_name,paste0(x_name,value),envir = parent.frame())
paste0(x_name,value)
}
a <- NA;add_str("b")
a
# [1] "ab"
Operations don't need to be on the same line, but they need to follow each other.
5 - Again a variant, using a print method hack
Extremely dirty and convoluted, to please the tortured spirits and troll the others.
This is the only one that really gives the expected output, but it works only in interactive mode.
The trick is that instead of doing all the work in the first operation I also use the second (printing). So in the first step I return an object whose value is "b", but I also assigned a class "weird" to it and a printing method, the printing method then modifies the object's value, resets its class, and destroys itself.
add_str <- function(x){
class(x) <- "weird"
assign("print.weird", function(x) {
env <- parent.frame(2)
x_name <- fetch_name(x, env)
assign(x_name,paste0(x_name,unclass(x)),envir = env)
rm(print.weird,envir = env)
print(paste0(x_name,x))
},envir = parent.frame())
x
}
a <- add_str("b")
a
# [1] "ab"
(a <- add_str("b") will have the same effect as both lines above. print(a <- add_str("b")) would also have the same effect but would work in non interactive code, as well.
This is generally not possible because the operator <- is actually parsed to a call of the <- function:
rapply(as.list(quote(a <- add_str("b"))),
function(x) if (!is.symbol(x)) as.list(x) else x,
how = "list")
#[[1]]
#`<-`
#
#[[2]]
#a
#
#[[3]]
#[[3]][[1]]
#add_str
#
#[[3]][[2]]
#[1] "b"
Now, you can access earlier calls on the call stack by passing negative numbers to sys.call, e.g.,
foo <- function() {
inner <- sys.call()
outer <- sys.call(-1)
list(inner, outer)
}
print(foo())
#[[1]]
#foo()
#[[2]]
#print(foo())
However, help("sys.call") says this (emphasis mine):
Strictly, sys.parent and parent.frame refer to the context of the
parent interpreted function. So internal functions (which may or may
not set contexts and so may or may not appear on the call stack) may
not be counted, and S3 methods can also do surprising things.
<- is such an "internal function":
`<-`
#.Primitive("<-")
`<-`(x, foo())
x
#[[1]]
#foo()
#
#[[2]]
#NULL
As Roland pointed, the <- is outside of the scope of your function and could only be located looking at the stack of function calls, but this fail. So a possible solution could be to redefine the '<-' else than as a primitive or, better, to define something that does the same job and additional things too.
I don't know if the ideas behind following code can fit your needs, but you can define a "verbose assignation" :
`:=` <- function (var, value)
{
call = as.list(match.call())
message(sprintf("Assigning %s to %s.\n",deparse(call$value),deparse(call$var)))
eval(substitute(var <<- value))
return(invisible(value))
}
x := 1:10
# Assigning 1:10 to x.
x
# [1] 1 2 3 4 5 6 7 8 9 10
And it works in some other situation where the '<-' is not really an assignation :
y <- data.frame(c=1:3)
colnames(y) := "b"
# Assigning "b" to colnames(y).
y
# b
#1 1
#2 2
#3 3
z <- 1:4
dim(z) := c(2,2)
#Assigning c(2, 2) to dim(z).
z
# [,1] [,2]
#[1,] 1 3
#[2,] 2 4
>
I don't think the function has access to the variable it is being assigned to. It is outside of the function scope and you do not pass any pointer to it or specify it in any way. If you were to specify it as a parameter, you could do something like this:
add_str <- function(x, y) {
arg0 <-deparse(substitute(x))
return(paste0(arg0, y))
}
a <- 5
add_str(a, 'b')
#"ab"

How to get the list of in-built functions used within a function

Lets say I have a function named Fun1 within which I am using many different in-built functions of R for different different processes. Then how can I get a list of in-built functions used inside this function Fun1
Fun1 <- function(x,y){
sum(x,y)
mean(x,y)
c(x,y)
print(x)
print(y)
}
So My output should be like list of characters i.e. sum, mean, c, print. Because these are the in-built functions I have used inside function Fun1.
I have tried using grep function
grep("\\(",body(Fun1),value=TRUE)
# [1] "sum(x, y)" "mean(x, y)" "c(x, y)" "print(x)" "print(y)"
It looks ok, but arguments should not come i.e. x and y. Just the list of function names used inside body of function Fun1 here.
So my overall goal is to print the unique list of in-built functions or any create functions inside a particular function, here Fun1.
Any help on this is highly appreciated. Thanks.
You could use all.vars() to get all the variable names (including functions) that appear inside the body of Fun1, then compare that with some prepared list of functions. You mention in-built functions, so I will compare it with the base package object names.
## full list of variable names inside the function body
(vars <- all.vars(body(Fun1)[-1], functions = TRUE))
# [1] "sum" "x" "y" "mean" "c" "print"
## compare it with the base package object names
intersect(vars, ls(baseenv()))
# [1] "sum" "mean" "c" "print"
I removed the first element of the function body because presumably you don't care about {, which would have been matched against the base package list.
Another possibility, albeit a bit less reliable, would be to compare the formal arguments of Fun1 to all the variable names in the function. Like I said, likely less reliable though because if you make assignments inside the function you will end up with incorrect results.
setdiff(vars, names(formals(Fun1)))
# [1] "sum" "mean" "c" "print"
These are fun though, and you can fiddle around with them.
Access to the parser tokens is available with functions from utils.
tokens <- utils::getParseData(parse(text=deparse(body(Fun1))))
unique(tokens[tokens[["token"]] == "SYMBOL_FUNCTION_CALL", "text"])
[1] "sum" "mean" "c" "print"
This should be somewhat helpful - this will return all functions however.
func_list = Fun1 %>%
body() %>% # extracts function
toString() %>% # converts to single string
gsub("[{}]", "", .) %>% # removes curly braces
gsub("\\s*\\([^\\)]+\\)", "", .) %>% # removes all contents between brackets
strsplit(",") %>% # splits strings at commas
unlist() %>% # converts to vector
trimws(., "both") # removes all white spaces before and after`
[1] "" "sum" "mean" "c" "print" "print"
> table(func_list)
func_list
c mean print sum
1 1 1 2 1
This is extremely limited to your example... you could modify this to be more robust. It will fall over where a function has brackets nesting other functions etc.
this is not so beautiful but working:
Fun1 <- function(x,y){
sum(x,y)
mean(x,y)
c(x,y)
print(x)
print(y)
}
getFNamesInFunction <- function(f.name){
f <- deparse(body(get(f.name)))
f <- f[grepl(pattern = "\\(", x = f)]
f <- sapply(X = strsplit(split = "\\(", x = f), FUN = function(x) x[1])
unique(trimws(f[f != ""]))
}
getFNamesInFunction("Fun1")
[1] "sum" "mean" "c" "print"
as.list(Fun1)[3]
gives you the part of the function between the curly braces.
{
sum(x, y)
mean(x, y)
c(x, y)
print(x)
print(y)
}
Hence
gsub( ").*$", "", as.list(Fun1)[3])
gives you everything before the first " ) " appears which is presumable the name of the first function.
Taking this as a starting point you should be able to include a loop which gives you the other functions and not the first only the first one.

R functions, access to parameter names

I have the following code:
fn <- 'George'
mn <- 'Walker'
ln <- 'Bush'
f <- function(...) { print(list(...)) }
When I call it, it produces the following output:
f(fn,mn,ln)
[[1]]
[1] "George"
[[2]]
[1] "Walker"
[[3]]
[1] "Bush"
Suppose I wanted something similar to this (note the parameter names):
fn:George
mn:Walker
ln:Bush
Question: I know how to get the VALUES of the arguments inside a function. How do I get the NAMES of the arguments inside the function?
Thanks, CC.
You may use
f <- function(...) {
nm1 <- as.list(match.call()[-1])
val <- list(...)
cat(paste(nm1, val, sep=":", collapse="\n"),'\n') }
f(fn,mn,ln)
#fn:George
#mn:Walker
#ln:Bush

deparse(substitute(x)) in lapply?

I would like use a function that uses the standard deparse(substitute(x)) trick within lapply. Unfortunately I just get the argument of the loop back. Here's my completely useless reproducible example:
# some test data
a <- 5
b <- 6
li <- list(a1=a,b2=b)
# my test function
tf <- function(obj){
nm <- deparse(substitute(obj))
res <- list(myName=nm)
res
}
tf(a)
#returns
$myName
[1] "a"
which is fine. If I use lapply I either get [[1L]] or the x argument of an anonymous function.
lapply(li,function(x) tf(x))
# returns
$a1
$a1$myName
[1] "x"
$b2
$b2$myName
[1] "x"
Is there any way to obtain the following?
$a1
$a1$myName
[1] "a1"
$b2
$b2$myName
[1] "b1"
If there's anything more general on deparse(substitute(x)) and lapply I'd also eager to know.
EDIT:
The problem as opposed to using an anonymous function that accepts multiple arguments and can thus use the name of the object and the object itself does not work because, the tf function will only accept one argument. So this does not work here...
A possible solution :
lapply(li, function(x) {
call1 <- sys.call(1)
call1[[1]] <- as.name("names")
call1 <- call1[1:2]
nm <- eval(call1)
y <- deparse(substitute(x))
y <- gsub("\\D", "", y)
y <- as.numeric(y)
list(myname=nm[y])
})

How can I pass multiple arguments to a function as a single vector?

I created the following function with six args:
nDone <- function(under,strike,ttoe,vol,rf,dy) {
pnorm(((log(under/strike)+ (rf-dy+(vol^2)/2)*ttoe)/(vol*(ttoe^0.5))))
}
nDone(90,100,3,0.17,0.05,0)
# Result:
[1] 0.6174643
Now I create a vector with the same values in an object, and try to call the function using the vector, but get the following error:
d <- c(90,100,3,0.17,0.05,0)
nDone(d)
Error in under/strike : 'strike' is missing
What am I doing wrong and how to fix?
Try this
do.call(nDone, as.list(d))
Explanation of what's happening in your first attempt by #joran from the comments:
R is seeing you pass a single argument to nDone, namely the vector d, which is handed off to the first function argument, under. Since you haven't specified a default value for the others, they are missing and hence the error
Maybe worth to add:
If your function can accept arguments that are vectors of length >1 and generates output of the same length, do.call can handle that, too, and you will need list():
x <- c("a", "b", "c")
y <- c(1, 2, 3)
> do.call(paste0,c(list(x),list(y)))
[1] "a1" "b2" "c3"
watch out that this won't fail or warn for vectors of unequal lengths:
x <- c("a", "b")
> do.call(paste0,c(list(x),list(y)))
[1] "a1" "b2" "a3"
Of course paste0(x,y) would work here just as well, but I'm using this e.g. for rgb():
# whichever complex functions to generate vector of floats:
x <- seq(1,6) %>% exp()
# rescale for rgb
x <- scales::rescale(x)
# make a list of vectors
# note that as.list() would not give the desired output here
x <- rep(list(x),3)
# call
> do.call(rgb, x)
[1] "#000000" "#030303" "#0B0B0B" "#212121" "#5D5D5D" "#FFFFFF"
or a tidy one line:
> seq(1,6) %>% exp() %>% scales::rescale() %>% list() %>% rep(3) %>% do.call(rgb,.)
[1] "#000000" "#030303" "#0B0B0B" "#212121" "#5D5D5D" "#FFFFFF"

Resources