I have a simple recursion function in R that would modify its input arguments. I use eval.parent(substitute()) in order to apply the changes on the arguments, However I get this error:
"invalid (do_set) left-hand side to assignment "
Does anyone know how to fix this error?
Here is my function:
decompose_clade=function(ind,Small_clades_ind,Remove_tips,Clades){
Ch=Children(tree,ind)
if(Ch[1]<length(tree$tip.label)){
l=Remove_tips
l=c(l,Ch[1])
eval.parent(substitute(Remove_tips=l))
print("tip added=")
print(Ch[1])
}else if(length(extract.clade(tree,Ch[1])$tip.label)<4){
s=Small_clades_ind
s=c(s,Ch[1])
eval.parent(substitute(Small_clades_ind=s))
print("small clade added=")
print(Ch[1])
}else if(length(extract.clade(tree,Ch[1])$tip.label)>80){
decompose_clade(Ch[1],Small_clades_ind,Remove_tips,Clades)
print("function calls again")
}else{
m=Clades
m=c(m,Ch[1])
eval.parent(substitute(Clades<-m))
print("a clade added=")
print(Ch[1])
}
}
There is no easy way to have pass-by-reference behaviours in R, with only one exception: environment. I'm not sure if environment suits your need, you can give it a try:
modify_input <- function(x){
x$z <- 1
}
x <- new.env(parent = emptyenv())
modify_input(x)
x$z
As to the usage, environment supports e$z and e[["z"]] and length(e) just like list, but it doesn't support e[[1]] and things like that. You can think of environment as a dictionary and elements in it have no order. If you want to list all the elements in an environment, you can use ls. And there are ways to transform environment to list (as.list) and vise versa (list2env). Hope it can help.
May be you can follow the following approach.
x <- 1
fn <- function() {
x <<- 2
}
Now x is 2.
Related
I've written an import function that gets a single file from an aws s3-bucket.
That function itself is a wrapper around aws.s3::s3read_using() which takes a reading function as its first argument.
Why do I wrap around aws.s3::s3read_using() ? Because I need to do some special error-handling and want the wrapping function to do some Recall() up to a limit... but that's a different story.
Now that i've successfully build and tested my wrapping function i want to do another wrapping arround that:
I want to iterate n times over my wrapper to bind the downloaded files together. I now have the difficulty to hand the 'reading_function' to the FUN argument of aws.s3::s3read_using().
I could do that by simply using ... - BUT!
I want to make clear to the USER of my wrapping wrapper, that he needs to specify that argument.
So I've decided to use rlangs rlang::enexpr() to capture the argument and to hand it over to my first wrapper via !! - which in return captures that argument again with rlang::enexpr() and hands it over - finally - to aws.s3::s3read_using() via rlang::expr(aws.s3::s3read_using(FUN = !!reading_fn, object = s3_object))
That works perfectly fine and smooth. My Problem is with testing that function construct using testthat and mockery
Here is some broadly simplyfied code:
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
# Some other magic happens here - error handling, condition-checking, etc...
out <- eval(rlang::expr((!!fn)(value_to_work_on)))
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
fn <- rlang::enexpr(fn_to_iter_with)
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(!!fn, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
Now, to the test:
# Throws an ERROR: 'Error in `!fn`: invalid argument type'
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I've used a workarround, but that just doesn't feel right, even though, it works:
# Test passed
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function",
function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
out <- mock_1(fn, value_to_work_on)
out})
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I'm using version of R: 4.1.1
I'm using versions of testthat(3.1.1), mockery(0.4.2), rlang(0.4.12)
I think you're complicating things here, although maybe I'm not fully understanding your end goal. You can directly pass functions through arguments without any issue. Your example code above can be easily simplified to (keeping the loop just to match your test_that() call):
library(testthat)
library(mockery)
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn_to_work_with(value_to_work_on)
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(fn_to_iter_with, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
#> [[1]]
#> [1] 3
#>
#> ...
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
#> Test passed 🥇
You can just pass FUN directly through all of your nested functions. The functions you're wrapping with enexpr() were never going to be evaluated in the first place until you explicitly call them. You usually use enexpr when users are supplying expressions, not just functions.
I stacked with trying to pass variable through few functions, and on the final function I want to get the name of the original variable. But it seems like substitute function in R looked only in "local" environment, or just for one level up. Well, let me explain it by code:
fun1 <- function (some_variable) {deparse(substitute(some_variable)}
fun2 <- function (var_pass) { fun1 (var_pass) }
my_var <- c(1,2) # I want to get 'my_var' in the end
fun2 (my_var) # > "var_pass"
Well, it seems like we printing the name of variable that only pass to the fun1. Documentation of the substitute tells us, that we can use env argument, to specify where we can look. But by passing .Global or .BaseNamespaceEnv as an argument to substitute I got even more strange results - "some_variable"
I believe that answer is in this function with using env argument, so, could you please explain me how it works and how can I get what I need. Thanks in advance!
I suggest you consider passing optional name value to these functions. I say this because it seems like you really want to use the name as a label for something in the end result; so it's not really the variable itself that matters so much as its name. You could do
fun1 <- function (some_variable, name=deparse(substitute(some_variable))) {
name
}
fun2 <- function (var_pass, name=deparse(substitute(var_pass))) {
fun1 (var_pass, name)
}
my_var <- c(1,2)
fun2(my_var)
# [1] "my_var"
fun1(my_var)
# [1] "my_var"
This way if you end up having some odd variable name and what to give a better name to a result, you at least have the option. And by default it should do what you want without having to require the name parameter.
One hack, probably not the best way:
fun2 <- function (var_pass) { fun1 (deparse(substitute(var_pass))) }
fun1 <- function (some_variable) {(some_variable))}
fun2(my_var)
# "my_var"
And you could run get on that. But as Paul H, suggests, there are better ways to track variables.
Another approach I'd like to suggest is to use rlang::enexpr.
The main advantage is that we don't need to carry the original variable name in a parameter. The downside is that we have to deal with expressions which are slightly trickier to use.
> fun1 <- function (some_variable) {
message("Entering fun1")
rlang::enexpr(some_variable)
}
> fun2 <- function (var_pass) {
message("Entering fun2")
eval(parse(text=paste0("fun1(", rlang::enexpr(var_pass), ")")))
}
> my_var <- c(1, 2)
> fun1(my_var)
#Entering fun1
my_var
> fun2(my_var)
#Entering fun2
#Entering fun1
my_var
The trick here is that we have to evaluate the argument name in fun2 and build the call to fun1 as a character. If we were to simply call fun1 with enexpr(var_pass), we would loose the notion of fun2's variable name, because enexpr(var_pass) would never be evaluated in fun2:
> bad_fun2 <- function (var_pass) {
message("Entering bad fun2")
fun1(rlang::enexpr(var_pass))
}
> bad_fun2(my_var)
#Entering bad fun2
#Entering fun1
rlang::enexpr(var_pass)
On top of that, note that neither fun1 nor fun2 return variable names as character vectors. The returned object is of class name (and can of course be coerced to character).
The bright side is that you can use eval directly on it.
> ret <- fun2(my_var)
#Entering fun2
#Entering fun1
> as.character(ret)
[1] "my_var"
> class(ret)
[1] "name"
> eval(ret)
[1] 1 2
I'm trying to read a function call as a string and evaluate this function within another function. I'm using eval(parse(text = )) to evaluate the string. The function I'm calling in the string doesn't seem to have access to the environment in which it is nested. In the code below, my "isgreater" function finds the object y, defined in the global environment, but can't find the object x, defined within the function. Does anybody know why, and how to get around this? I have already tried adding the argument envir = .GlobalEnv to both of my evals, to no avail.
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval(y > x))
}
y <- 4
test <- function() {
x <- 3
return(eval(parse(text = str)))
}
test()
Error:
Error in eval(y > x) : object 'x' not found
Thanks to #MrFlick and #r2evans for their useful and thought-provoking comments. As far as a solution, I've found that this code works. x must be passed into the function and cannot be a default value. In the code below, my function generates a list of results with the x variable being changed within the function. If anyone knows why this is, I would love to know.
str <- "isgreater(y, x)"
isgreater <- function(y, x) {
return(eval(y > x))
}
y <- 50
test <- function() {
list <- list()
for(i in 1:100) {
x <- i
bool <- eval(parse(text = str))
list <- append(list, bool)
}
return(list)
}
test()
After considering the points made by #r2evans, I have elected to change my approach to the problem so that I do not arrive at this string-parsing step. Thanks a lot, everyone.
I offer the following code, not as a solution, but rather as an insight into how R "works". The code does things that are quite dangerous and should only be examined for its demonstration of how to assert a value for x. Unfortunately, that assertion does destroy the x-value of 3 inside the isgreater-function:
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval( y > x ))
}
y <- 4
test <- function() {
environment(isgreater)$x <- 5
return(eval(parse(text = str) ))
}
test()
#[1] FALSE
The environment<- function is used in the R6 programming paradigm. Take a look at ?R6 if you are interested in working with a more object-oriented set of structures and syntax. (I will note that when I first ran your code, there was an object named x in my workspace and some of my efforts were able to succeed to the extent of not throwing an error, but they were finding that length-10000 vector and filling up my console with logical results until I escaped the console. Yet another argument for passing both x and y to isgreater.)
Consider the following functions
f1 <- function(x) {
# do something
x
}
f2 <- function(x) {
# do something
invisible(x)
}
Suppose I call these two functions separately and save their values.
a <- f1(1)
b <- f2(2)
Is there a way to know if a and b are invisibly returned?
The motivation is that I want to create a function in which if a value is invisibly returned the function also wants to return the value invisibly.
There's withVisible, which lets you do this:
> f3 = function(f, x){
v=withVisible(f(x))
if(v$visible){
return(v$value)
}else{
return(invisible(v$value))
}
}
> f3(f1,1)
[1] 1
> f3(f2,1)
There's no way of doing it once you've got a and b, since identical(a,b) is TRUE. You can only call withVisible on an expression. Unless something lazy or promisy is going on.
A possible alternative to Spacedman's (proper :-) ) solution is to put the following line inside your "outer" function.
if (grepl('invisible', body(inner_function) ) ) return(invisible(data)) else return(data)
Obviously this will fail if you do something creative like naming a variable "pinvisible"
UPDATE: I have added a variant
of Roland's implementation to the kimisc package.
Is there a convenience function for exporting objects to the global environment, which can be called from a function to make objects available globally?
I'm looking for something like
export(obj.a, obj.b)
which would behave like
assign("obj.a", obj.a, .GlobalEnv)
assign("obj.b", obj.b, .GlobalEnv)
Rationale
I am aware of <<- and assign. I need this to refactor oldish code which is simply a concatenation of scripts:
input("script1.R")
input("script2.R")
input("script3.R")
script2.R uses results from script1.R, and script3.R potentially uses results from both 1 and 2. This creates a heavily polluted namespace, and I wanted to change each script
pollute <- the(namespace)
useful <- result
to
(function() {
pollute <- the(namespace)
useful <- result
export(useful)
})()
as a first cheap countermeasure.
Simply write a wrapper:
myexport <- function(...) {
arg.list <- list(...)
names <- all.names(match.call())[-1]
for (i in seq_along(names)) assign(names[i],arg.list[[i]],.GlobalEnv)
}
fun <- function(a) {
ttt <- a+1
ttt2 <- a+2
myexport(ttt,ttt2)
return(a)
}
print(ttt)
#object not found error
fun(2)
#[1] 2
print(ttt)
#[1] 3
print(ttt2)
#[1] 4
Not tested thoroughly and not sure how "safe" that is.
You can create an environment variable and use it within your export function. For example:
env <- .GlobalEnv ## better here to create a new one :new.env()
exportx <- function(x)
{
x <- x+1
env$y <- x
}
exportx(3)
y
[1] 4
For example , If you want to define a global options(emulate the classic R options) in your package ,
my.options <- new.env()
setOption1 <- function(value) my.options$Option1 <- value
EDIT after OP clarification:
You can use evalq which take 2 arguments :
envir the environment in which expr is to be evaluated
enclos where R looks for objects not found in envir.
Here an example:
env.script1 <- new.env()
env.script2 <- new.env()
evalq({
x <- 2
p <- 3
z <- 5
} ,envir = env.script1,enclos=.GlobalEnv)
evalq({
h <- x +2
} ,envir = env.script2,enclos=myenv.script1)`
You can see that all variable are created within the environnment ( like local)
env.script2$h
[1] 4
env.script1$p
[1] 3
> env.script1$x
[1] 2
First, given your use case, I don't see how an export function is any better than using good (?) old-fashioned <<-. You could just do
(function() {
pollute <- the(namespace)
useful <<- result
})()
which will give the same result as what's in your example.
Second, rather than anonymous functions, it seems better form to use local, which allows you to run involved computations without littering your workspace with various temporary objects.
local({
pollute <- the(namespace)
useful <<- result
})
ETA: If it's important for whatever reason to avoid modifying an existing variable called useful, put an exists check in there. The same applies to the other solutions presented.
local({
.....
useful <- result
if(!exists("useful", globalenv())) useful <<- useful
})