Accessing the function that is being called from within the function - r

Within a function, how can we reliably return an object that contains the function itself?
For example with:
functionBuilder <- function(wordToSay) {
function(otherWordToSay) {
print(wordToSay)
print(otherWordToSay)
get(as.character(match.call()[[1]]))
}
}
I can build a function like so:
functionToRun <- functionBuilder("hello nested world")
... and run it ...
functionToRun("A")
#[1] "hello nested world"
#[1] "A"
#
#function(otherWordToSay) {
# print(wordToSay)
# print(otherWordToSay)
# get(as.character(match.call()[[1]]))
# }
#<environment: 0x1e313678>
... as you can see functionToRun returns itself. However, this approach appears to break if I call functionToRun via sapply:
> sapply(LETTERS, functionToRun)
#[1] "hello nested world"
#[1] "A"
#Error in get(as.character(match.call()[[1]])) : object 'FUN' not found
I can see that this is because the actual call when using sapply is FUN but that FUN doesn't exist at pos = -1 (the default for get). Code that works in that position looks like:
get(as.character(match.call()[[1]]),envir = sys.frame(sys.parent()))
But that same code fails if the function hasn't been called via sapply because sys.frame(sys.parent())) goes too far back and ends up referring to R_GlobalEnv.
From the documentation (R 3.2.2) I'd have expected dynGet to perhaps solve the issue of only going as far back in the stack as needed. Although this works for an sapply call of the function, it fails when the function is called on its own. (Besides, it is marked as 'somewhat experimental'). Inversely getAnywhere seems promising, but doesn't seem to work for the sapply called function.
Is there a reliable way to return the function that is currently being processed, i.e. works for both a bare and sapply wrapped function call?
What I'm doing right now is wrapping the attempt to grab the function in a tryCatch; but I'm a little uncertain whether I can trust that get(as.character(match.call()[[1]]),envir = sys.frame(sys.parent())) will work in all wrapping cases (not just sapply). So, I'm looking for a more reasonable way to approach this problem.
Potentially Related Questions:
How to access a variable stored in a function in R
How to get the name of the calling function inside the called routine?

I can't guarantee that this will work in all cases, but it looks okay:
fun <- function(x) {
print(x)
y <- exp(x)
print(y)
sys.function(0)
}
fun(1)
# [1] 1
# [1] 2.718282
# function(x) {
# print(x)
# y <- exp(x)
# print(y)
# sys.function(0)
# }
lapply(1:5, fun)[[3]]
# [1] 1
# [1] 2.718282
# [1] 2
# [1] 7.389056
# [1] 3
# [1] 20.08554
# [1] 4
# [1] 54.59815
# [1] 5
# [1] 148.4132
# function(x) {
# print(x)
# y <- exp(x)
# print(y)
# sys.function(0)
# }
Of course, I don't understand what you need this for.

Related

How do I force my vector to split into arguments?

I'm having problems with applying a function to a vector of arguments. The point is, none of the arguments are vectors.
I'm trying to apply my function with the do.call command, and my attempts go like this:
do.call("bezmulti", list(dat$t, as.list(getvarnames(n, "a"))))
where bezmulti is a function that takes in a vector (dat$t) and an indefinite number of single numbers, which are provided by the function getvarnames in the form of a vector, which I need to split.
The problem is that this list doesn't work the way I want it to - the way I would want would be:
[[1]]
#vector goes here
[[2]]
#the
[[3]]
#numbers
[[4]]
#go
[[5]]
#here
however my proposed solution, and all my other solutions provide lists that are either somehow nested or have only two elements, both of which are vectors. Is there a way to force the list to be in the format above?
EDIT: Functions used in this post look as follows
bezmulti <- function(t,...) {
coeff <- list(...)
n <- length(coeff)-1
sumco <- rep(0, length(t))
for (i in c(0:n)) {
sumco=sumco+coeff[[i+1]]*choose(n, i)*(1-t)^(n-i)*t^i
}
return(sumco)
}
getvarnames <- function(n, charasd) {
vec=NULL
for (j in c(1:n)) {
vec <- append(vec, eval(str2expression(paste0(charasd, as.character(j)))))
}
return(vec)
}
I think what you need to do is this:
do.call("bezmulti", c(list(dat$t), as.list(getvarnames(n, "a"))))
For example:
dat= data.frame(t = c(1,2,3,4,6))
c(list(dat$t), as.list(c(8,10,12)))
Output:
[[1]]
[1] 1 2 3 4 6
[[2]]
[1] 8
[[3]]
[1] 10
[[4]]
[1] 12

Use object name in function with map/lapply [duplicate]

I am looking for the reverse of get().
Given an object name, I wish to have the character string representing that object extracted directly from the object.
Trivial example with foo being the placeholder for the function I am looking for.
z <- data.frame(x=1:10, y=1:10)
test <- function(a){
mean.x <- mean(a$x)
print(foo(a))
return(mean.x)}
test(z)
Would print:
"z"
My work around, which is harder to implement in my current problem is:
test <- function(a="z"){
mean.x <- mean(get(a)$x)
print(a)
return(mean.x)}
test("z")
The old deparse-substitute trick:
a<-data.frame(x=1:10,y=1:10)
test<-function(z){
mean.x<-mean(z$x)
nm <-deparse(substitute(z))
print(nm)
return(mean.x)}
test(a)
#[1] "a" ... this is the side-effect of the print() call
# ... you could have done something useful with that character value
#[1] 5.5 ... this is the result of the function call
Edit: Ran it with the new test-object
Note: this will not succeed inside a local function when a set of list items are passed from the first argument to lapply (and it also fails when an object is passed from a list given to a for-loop.) You would be able to extract the ".Names"-attribute and the order of processing from the structure result, if it were a named vector that were being processed.
> lapply( list(a=4,b=5), function(x) {nm <- deparse(substitute(x)); strsplit(nm, '\\[')} )
$a # This "a" and the next one in the print output are put in after processing
$a[[1]]
[1] "X" "" "1L]]" # Notice that there was no "a"
$b
$b[[1]]
[1] "X" "" "2L]]"
> lapply( c(a=4,b=5), function(x) {nm <- deparse(substitute(x)); strsplit(nm, '\\[')} )
$a
$a[[1]] # but it's theoretically possible to extract when its an atomic vector
[1] "structure(c(4, 5), .Names = c(\"a\", \"b\"))" ""
[3] "1L]]"
$b
$b[[1]]
[1] "structure(c(4, 5), .Names = c(\"a\", \"b\"))" ""
[3] "2L]]"
deparse(quote(var))
My intuitive understanding
In which the quote freeze the var or expression from evaluation
and the deparse function which is the inverse of parse function makes that freezed symbol back to String
Note that for print methods the behavior can be different.
print.foo=function(x){ print(deparse(substitute(x))) }
test = list(a=1, b=2)
class(test)="foo"
#this shows "test" as expected
print(test)
#this (just typing 'test' on the R command line)
test
#shows
#"structure(list(a = 1, b = 2), .Names = c(\"a\", \"b\"), class = \"foo\")"
Other comments I've seen on forums suggests that the last behavior is unavoidable. This is unfortunate if you are writing print methods for packages.
To elaborate on Eli Holmes' answer:
myfunc works beautifully
I was tempted to call it within another function (as discussed in his Aug 15, '20 comment)
Fail
Within a function, coded directly (rather than called from an external function), the deparse(substitute() trick works well.
This is all implicit in his answer, but for the benefit of peeps with my degree of obliviousness, I wanted to spell it out.
an_object <- mtcars
myfunc <- function(x) deparse(substitute(x))
myfunc(an_object)
#> [1] "an_object"
# called within another function
wrapper <- function(x){
myfunc(x)
}
wrapper(an_object)
#> [1] "x"

R - Naming multiple functions in a for loop

I have the following data frame:
> coc_comp_model[1:3,]
Relationship Output Input |r-Value| Y-Intercept Gradient
1 DG-r ~ DG-cl DG-r DG-cl 0.8271167 0.0027217513 12.9901380
2 CA3-r ~ CA3-cl CA3-r CA3-cl 0.7461309 0.0350767684 27.6107963
3 CA2-r ~ CA2-cl CA2-r CA2-cl 0.9732584 -0.0040992226 35.8299582
I want to create simple functions for each row of the data frame. here's what I've tried:
for(i in 1:nrow(coc_comp_model)) {
coc_glm_f[i] <- function(x)
x*coc_comp_model$Gradient[i] + coc_comp_model$Y-Intercept[i]
}
also tried making a vector of functions, which also does ont work either.
Thanks for reading this/helping.
Something like this:
myfunc<-function(datrow, x){
x*as.numeric(datrow[6]) + as.numeric(datrow[5] )
}
Then you can use apply to call it on each row, changing x as desired:
apply(hzdata, 1, myfunc, x = 0.5)
note: using dput() to share your data is much easier than a pasting in a subset.
There is no such thing as a vector of functions. There are 6 atomic vector types in R: raw, logical, integer, double, complex, and character, plus there is the heterogeneous list type, and finally there is the lesser known expression type, which is basically a vector of parse trees (such as you get from a call to the substitute() function). Those are all the vector types in R.
printAndType <- function(x) { print(x); typeof(x); };
printAndType(as.raw(1:3));
## [1] 01 02 03
## [1] "raw"
printAndType(c(T,F));
## [1] TRUE FALSE
## [1] "logical"
printAndType(1:3);
## [1] 1 2 3
## [1] "integer"
printAndType(as.double(1:3));
## [1] 1 2 3
## [1] "double"
printAndType(c(1i,2i,3i));
## [1] 0+1i 0+2i 0+3i
## [1] "complex"
printAndType(letters[1:3]);
## [1] "a" "b" "c"
## [1] "character"
printAndType(list(c(T,F),1:3,letters[1:3]));
## [[1]]
## [1] TRUE FALSE
##
## [[2]]
## [1] 1 2 3
##
## [[3]]
## [1] "a" "b" "c"
##
## [1] "list"
printAndType(expression(a+1,sum(1,2+3*4),if (T) 1 else 2));
## expression(a + 1, sum(1, 2 + 3 * 4), if (T) 1 else 2)
## [1] "expression"
If you want to store multiple functions in a single object, you have to use a list, and you must use the double-bracket indexing operator in the lvalue to assign to it:
fl <- list();
for (i in 1:3) fl[[i]] <- (function(i) { force(i); function(a) a+i; })(i);
fl;
## [[1]]
## function (a)
## a + i
## <environment: 0x600da11a0>
##
## [[2]]
## function (a)
## a + i
## <environment: 0x600da1ab0>
##
## [[3]]
## function (a)
## a + i
## <environment: 0x600da23f8>
sapply(fl,function(f) environment(f)$i);
## [1] 1 2 3
sapply(fl,function(f) f(3));
## [1] 4 5 6
In the above code I also demonstrate the proper way to closure around a loop variable. This requires creating a temporary function evaluation environment to hold a copy of i, and the returned function will then closure around that evaluation environment so that it can access the iteration-specific i. This holds true for other languages that support dynamic functions and closures, such as JavaScript. In R there is an additional requirement of forcing the promise to be resolved via force(), otherwise, for each generated function independently, the promise wouldn't be resolved until the first evaluation of that particular generated function, which would at that time lock in the current value of the promise target (the global i variable in this case) for that particular generated function. It should also be mentioned that this is an extremely wasteful design, to generate a temporary function for every iteration and evaluate it, which generates a new evaluation environment with a copy of the loop variable.
If you wanted to use this design then your code would become:
coc_glm_f <- list();
for (i in 1:nrow(coc_comp_model)) {
coc_glm_f[[i]] <- (function(i) { force(i); function(x) x*coc_comp_model$Gradient[i] + coc_comp_model$`Y-Intercept`[i]; })(i);
};
However, it probably doesn't make sense to create a separate function for every row of the data.frame. If you intended the x parameter to take a scalar value (by which I mean a one-element vector), then you can define the function as follows:
coc_glm_f <- function(x) x*coc_comp_model$Gradient + coc_comp_model$`Y-Intercept`;
This function is vectorized, meaning you can pass a vector for x, where each element of x would correspond to a row of coc_comp_model. For example:
coc_comp_model <- data.frame(Relationship=c('DG-r ~ DG-cl','CA3-r ~ CA3-cl','CA2-r ~ CA2-cl'),Output=c('DG-r','CA3-r','CA2-r'),Input=c('DG-cl','CA3-cl','CA2-cl'),`|r-Value|`=c(0.8271167,0.7461309,0.9732584),`Y-Intercept`=c(0.0027217513,0.0350767684,-0.0040992226),Gradient=c(12.9901380,27.6107963,35.8299582),check.names=F);
coc_glm_f(seq_len(nrow(coc_comp_model)));
## [1] 12.99286 55.25667 107.48578

print if not assigned

How can I write into a function a way to detect if the output is being assigned (<-) to something? The reasoning is I'd like to print a message if it is not being assigned and just goes to the console but if it is being assigned I'd like it not to print the message.
Here's a dummy example and how I'd like it to behave:
fun <- function(x) {
if (being_assigned) {
print("message")
}
return(x)
}
#no assignment so message prints
> fun(6)
[1] "message"
[1] 6
#assignment so message does not prints
> x <- fun(6)
The being_assigned in the function is the imaginary unknown condition I'd like to detect but don't know how.
I think the best you can do is to define a special print method for objects returned by the function:
## Have your function prepend "myClass" to the class of the objects it returns
fun <- function(x) {
class(x) <- c("myClass", class(x))
x
}
## Define a print method for "myClass". It will be dispatched to
## by the last step of the command line parse-eval-print cycle.
print.myClass <- function(obj) {
cat("message\n")
NextMethod(obj)
}
> fun(1:10)
message
[1] 1 2 3 4 5 6 7 8 9 10
attr(,"class")
[1] "myClass"
>
> out <- fun(1:10)
>
I love Josh's idea but for future posters wanted to show what I did which is a slightly modified version of his approach. His approach prints out the class information which is the only thing I didn't like. He used the NextMethod to avoid the infinite recursion printing. This causes the
attr(,"class")
[1] "myClass"
to be printed. So to avoid this I print the message first and then print 1 through the length of the class object (using indexing).
fun <- function(x) {
class(x) <- 'beep'
comment(x) <- "hello world"
return(x)
}
print.beep<- function(beep) {
cat(paste0(comment(beep), "\n"))
print(beep[1:length(beep)])
}
> fun(1:10)
hello world
[1] 1 2 3 4 5 6 7 8 9 10
Thanks again Josh for the idea.
If the reader didn't want the little [1] index to print either they could cat the output int he print statement as:
print.beep<- function(beep) {
cat(paste0(comment(beep), "\n"))
cat(beep[1:length(beep)], "\n")
}

R - Get formals from call object

How can I get the formals (arguments) from a call object? formals() only seems to work with functions.
Well, a call does not have formals, only actual arguments... The difference being that a function like foo <- function(x, y, ..., z=42) can be called with actual arguments like foo(42, bar=13).
...But getting the arguments can be done like this:
a <- call('foo', a=42, 13)
as.list(a)[-1]
#$a
#[1] 42
#
#[[2]]
#[1] 13
...on the other hand, you can usually (not always) find the actual function and find the formals for it:
a <- quote(which(letters=='g'))
formals(match.fun(a[[1]]))
#$x
#
#$arr.ind
#[1] FALSE
#
#$useNames
#[1] TRUE
Here you'd need to add some error handling if the function can't be found (as with the call to foo above)...

Resources