Evaluate and save Argument variable value during function definition? - r

Consider this function plus_x:
y <- 1
plus_x <- function(input, x = y){
return(input + x)
}
here the y default-value for x is evaluated during the function call.
If I change y later on, I am also changing the functions behaviour.
y <- 1
plus_x <- function(input, x = y){
return(input + x)
}
y <-10
plus_x(1)
# > 11
Is there a way to "cement" the value for y to the state it was during the function definition?
Target:
y <- 1
plus_x <- function(input, x = y){
# y is now always 1
return(input + x)
}
y <-10
plus_x(1)
# > 2

1) local Surround the function with a local that saves y locally:
y <- 1
plus_x <- local({
y <- y
function(input, x = y) input + x
})
y <-10
plus_x(1)
## [1] 2
2) generator Another approach is to create a generator function. This has the advantage that multiple different functions with different y values could be easily defined. Look at demo("scoping", package = "base") for more examples of using scoping.
gen <- function(y) {
force(y)
function(input, x = y) input + x
}
y <- 1
plus_1 <- gen(y)
y <-10
plus_1(1)
## [1] 2
y <- 2
plus_2 <- gen(y)
y <- 10
plus_2(1)
## [1] 3

You could define the function using as.function so that the default value is evaluated at the time of function construction.
y <- 1
plus_x <- as.function(list(input = NULL, x = y, quote({
return(input + x)
})))
plus_x(1)
#> [1] 2
y <-10
plus_x(1)
#> [1] 2

Related

Why does r str changes evaluation

Using str() appears to change the evaluation why?
MWE:
f1 <- function(x, y = x) {
str(y)
x <- x + 1
y }
f1(1) # result is 1
f2 <- function(x, y = x) {
x <- x + 1
y }
f2(1) # result is 2
Why does this happen? I tried to use pryr library to debug but can not see the references being updated.
Lazy evaluation. It is about when y = x is evaluated. It is evaluated right before the first statement that uses y.
## f1
y <- x
str(y) ## first use of y
x <- x + 1
y
## f2
x <- x + 1
y <- x
y ## first use of y

purrr::pmap with user-defined functions and named list

The following piece of code works as expected:
library(tidyverse)
tib <- tibble(x = c(1,2), y = c(2,4), z = c(3,6))
tib %>% pmap(c)
#[[1]]
#x y z
#1 2 3
#
#[[2]]
#x y z
#2 4 6
But if I define the function
my_c_1 <- function(u, v, w) c(u, v, w)
I get an error:
tib %>% pmap(my_c_1)
#Error in .f(x = .l[[c(1L, i)]], y = .l[[c(2L, i)]], z = .l[[c(3L, i)]], :
# unused arguments (x = .l[[c(1, i)]], y = .l[[c(2, i)]], z = .l[[c(3, i)]])
Equivalently, for a named list with the base vector function all works well:
lili_1 <- list(x = list(1,2), y = list(2,4), z = list(3,6))
pmap(lili_1, c)
#[[1]]
#x y z
#1 2 3
#
#[[2]]
#x y z
#2 4 6
And with the user-defined function I get the same error:
pmap(lili_1, my_c_1)
#Error in .f(x = .l[[c(1L, i)]], y = .l[[c(2L, i)]], z = .l[[c(3L, i)]], :
#unused arguments (x = .l[[c(1, i)]], y = .l[[c(2, i)]], z = .l[[c(3, i)]])
However, for an un-named list with the user-defined function, it works:
lili_2 <- list(list(1,2), list(2,4), list(3,6))
pmap(lili_2, my_c_1)
#[[1]]
#[1] 1 2 3
#
#[[2]]
#[1] 2 4 6
I don't quite understand why things break with named lists and user-defined functions. Any insight?
BTW, I found a temporary workaround by defining:
my_c_2 <- function(...) c(...)
Then all works well, even with named lists... which leaves me even more puzzled.
This is in the spirit of a minimal reproducible example. In my current working code I would like to be able to pipe tibbles to pmap with my more general defined function without using the ... workaround for my variables.
your function my_c_1 has arguments u, v, w but you pass a list with names x, y, z. If you don't want a function with no named arguments (..., such as base's c), you should make sure the names match in your call.

R - Function that accesses a variable defined in another function on the same level

So I'm in the middle of a project at the moment, and I've encountered a problem with scoping. Below is a simplification of my problem.
a <- function() {
x <- 1:3 ## x is defined in a()
w <- d()
x
w
}
b <- function() {
y <- x[2] ## I want to access x from b()
x <- x[-2] ## and modify x
return(y)
}
d <- function() {
z <- b() ## then call b() from d()
return(list(1, z, 3, 4))
}
a()
When I run a(), the ideal output would be w equal to list(1, 2, 3, 4) and x equal to c(1, 3) . I am aware that I could define x globally, however x should be 'invisible' to d().
I have tried using parent.frame() in b(), but it doesn't work, probably because d() is its parent and not a(). I have also messed around with environment(), but I'm having trouble understanding the structure.
1) local environment We can define the functions in a local environment which shares x. Since x, b and d are only used internally we only need to provide a back to the workspace.
a <- local({
x <- NULL
b <- function() { y <- x[2]; x <<- x[-2]; y }
d <- function() { z <- b(); list(1, z, 3, 4) }
function() { x <<- 1:3; d() }
})
giving:
> x # x should not be visible
Error: object 'x' not found
> a()
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
[[4]]
[1] 4
2) nested functions Another approach is to nest the functions:
a <- function() {
b <- function() { y <- x[2]; x <<- x[-2]; y }
d <- function() { z <- b(); list(1, z, 3, 4) }
x <- 1:3
d()
}
a()
giving:
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
[[4]]
[1] 4
3) Using object models
Although this allows us to run a without having x visible it may be preferable to use one of the R object models to define an object in which a, b and d are methods of that object and x is a property.
The proto package implements a pure object based model (i.e. no classes) which seems particularly approrpiate here:
library(proto)
p <- proto(x = NULL,
b = function(.) { y <- .$x[2]; .$x <- .$x[-2]; y},
d = function(.) { z <- .$b(); list(1, z, 3, 4) },
a = function(.) { .$x <- 1:3; .$d() }
)
p$a()
giving:
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
[[4]]
[1] 4
The proto code can also be written in the style of (1) and (2) but then inheritance won't work. Since we don't use that here anyways it may not matter.
library(proto)
p <- proto(x = NULL,
b = function(.) { y <- x[2]; x <<- x[-2]; y},
d = function(.) { z <- b(); list(1, z, 3, 4) },
a = function(.) { x <<- 1:3; d() }
)
p$a()
4) Making x invisible to d If you really want to make x not visible to d then for (1) change it to this:
L <- local({
x <- NULL
list(b = function() { y <- x[2]; x <<- x[-2]; y },
a = function() { x <<- 1:3; d() })
})
d <- function() { z <- L$b(); list(1, z, 3, 4) }
L$a()
Actually if d really wanted to get to x it could access it like this; however, one would really have to make an effort:
environment(a)$x
For (2) we would change the code to this:
L <- function() {
x <- NULL
list(b = function() { y <- x[2]; x <<- x[-2]; y },
a = function() { x <<- 1:3; d() })
}
L <- L()
d <- function() { z <- L$b(); list(1, z, 3, 4) }
L$a()
Again it is actually possible for d to access x but, again, it requires considerable effort:
environment(L$a)$x
For (3) we change the code to this:
library(proto)
p <- proto(.x = NULL,
b = function(.) { y <- .$.x[2]; .$x <- .$.x[-2]; y},
a = function(.) { .$.x <- 1:3; d() }
)
d = function() { z <- p$b(); list(1, z, 3, 4) }
p$a()
As with (1) and (2) with some effort we can access x from d if we really want via:
p$.x
but accessing a dot variable from outside its object would be quite noticeable.
Note: Based on comment you might prefer this:
e <- local({
self <- environment()
x <- NULL
a <- function() { self$x <- 1:3; d(self) }
b <- function() { y <- x[2]; self$x <- x[-2]; y }
self
})
d <- function(e) { z <- e$b(); list(1, z, 3, 4) }
e$a()
This makes it clear that e is identified as an object of which a and b are methods and x is a property and d is acting on the passed environment. It also avoids the ugly environment(a)$b() referred to in the comment.
Although less preferred, you could omit the argument to d and just hard code e into d. Note that d can access x via e$x so it is not truly invisible but one would have to go to the extra effort of qualifying it. The reason this is less preferred is that by hard-coding e into d we are tying d to e. In that case it would be more logical to just put d right in e since it is tied to anyways. On the other hand, if we pass e to d then d is not tied to any particular environment.

R: Using Arguments of One Function as Parameter for Another

I'm trying to create a custom function that has an arugment that requires the arguments of another function. For instance, something like this:
funct1 <- function(x,y,z){
x + y + z
}
funct2 <- function(funct1, multiplier) {
print("first arg is ": [funct1 x arg]
print("second arg is ": [funct1 y arg]
print("third arg is ": [funct1 z arg]
}
first <- funct1(1,2,3)
funct2(first1, 2)
#first arg is 1
#second arg is 2
#third arg is 3
first <- funct1(3,4,5) #12
funct2(first1, 2)
#first arg is 3
#second arg is 4
#third arg is 5
If you want to be able to pass the function and arguments into the new function without having to define what those arguments are then you can use ...
f1 <- function(x, y, z){x + y + z}
f2 <- function(x, y){x * y}
doubler <- function(func, ...){
func(...) * 2
}
f1(1, 2, 3)
# 6
doubler(f1, 1, 2, 3)
# 12
f2(3, 4)
# 12
doubler(f2, 3, 4)
# 24
You simply need to have the same variable in each. What is the end game for this though?
funct1 <- function(x,y,z){
x + y + z
}
funct2 <- function(x,y,z) {
funct1(x,y,z) * 2
}
funct2(3,4,5)
> 24

How to define a flexible 'function expression' in R

Is it possible to write a flexible function expression?
I want to use input arguments to control the expression of function.
For example
input arg -> function
c(1,1) -> func1 = function(x) x+1
c(1,3,2) -> func2 = function(x) x^2+3*x+2
c(6,8,-1) -> func3 = function(x) 6*x^2+8*x-1
makepoly <- function(b)
{
p <- rev(seq_along(b) - 1)
function(x)
{
xp <- outer(x, p, '^')
rowSums(xp * rep(b, each=length(x)))
}
}
# x^2 + 2x + 3
f <- makepoly(1:3)
f(0:4)
[1] 3 6 11 18 27
Here is my take on this task
create_poly <- function(coef)
paste(rev(coef),
paste("x", seq_along(coef) - 1, sep = "^"),
sep = "*", collapse = " + ")
make_polyfun <- function(input) {
myfun <- paste("function(x)", create_poly(input))
eval(parse(text = myfun))
}
With the example the OP gave we have :
make_polyfun(c(1, 1))
## function(x) 1*x^0 + 1*x^1
## <environment: 0x243a540>
make_polyfun(c(1, 3, 2))
## function(x) 2*x^0 + 3*x^1 + 1*x^2
## <environment: 0x1bd46e0>
make_polyfun(c(6, 8, 1))
## function(x) 1*x^0 + 8*x^1 + 6*x^2
## <environment: 0x22a59c0>
You can use polynom
library(polynom)
as.polynomial(c(2,3,1))
2 + 3*x + x^2
as.polynomial(c(6,8,1)
1 + 8*x + 6*x^2
EDIT you can of course coerce the result to a function using the genericas.function.polynomial. better here you can use ,as.polylist` to create many polynomials given a list of coefficients lists. For example:
lapply(as.polylist(list(c(2,3,1),c(6,8,1),c(6,8,-1))),
as.function)
[[1]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 3 + x * w
w <- 2 + x * w
w
}
<environment: 0x00000000113bd778>
[[2]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011524168>
[[3]]
function (x)
{
w <- 0
w <- -1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011527f28>
It's not clear how general you want to be from OP. For the particular case of polynomials, you can do:
f = function(x, coeffs) {
sum(outer(x, seq_along(coeffs) - 1, `^`) * coeffs)
}
f(2, c(1,2,3)) # 1 + 2*x + 3*x^2, with x = 2
#[1] 17
I read this as the desire to make functions and I think the agstudy/eddi responses would probably do this, but I thought trying it from scratch might be instructive:
poly.maker <- function(coefs) { func <- function(x){} #empty func in x
body(func) <- parse(text= paste( seq_along(coefs),"*x^",
(length(coefs)-1):0,collapse="+" ) )
return(func) }
func2 <- poly.maker(c(1,2,3)) # return a function
func2(3) # now test it out
#[1] 18
Note I needed to swap the order to agree with the OP request, which I only noticed after getting different results than #dickoa. This seems less clunky:
poly.make2 <- function(coefs) { func <- function(x){}
body(func) <- bquote(sum(.(coefs)*x^.( (length(coefs)-1):0 ) ) )
return(func) }
func <- poly.make2(c(1,2,5))
func
#function (x)
#sum(c(1, 2, 5) * x^c(2L, 1L, 0L))
#<environment: 0x29023d508>
func(3)
#[1] 20
One liner:
polymaker2 <- function(coefs)
{
eval(parse(text=paste0( "function(x) sum(x^(",length(coefs)-1,":0) * ",capture.output(dput(coefs)),")" )))
}
Vectorized form:
polymaker3 <- function(coefs)
{
eval(parse(text=paste0( "function(x) colSums(t(outer(x, ",length(coefs)-1,":0, `^`))*",capture.output(dput(coefs)),")" )))
}

Resources