What I want to do is the following: I want to write a function, let's call it 'function_creator' with one argument: name, and some additional arguments, such that its output is a function for which the name of the argument is the argument I passed to 'function_creator'.
The following code-snippet illustrates how I would like function_creator to behave:
f <- function_creater(name = "y", y_min = 2, y_max = 3)
f
function(y) {
y >= 2 && y <= 3
}
How do I do this in R?? I guess that something like sys.call() might be helpful but I don't really know how to proceed from there.
Using rlang::new_function() you can do this. This uses exprs() from rlang as well to create an argument with no default value (i.e., a named list with nothing in it. The body of the function is put in the substitute() function to swap in the values for the variable names.
library(rlang)
function_creater <- function(name, y_min, y_max) {
new_args <- setNames(exprs(temp_name = ), name)
new_body <- substitute((y >= y_min && y <= y_max), list(y = sym(name),
y_min = y_min,
y_max = y_max))
new_function(new_args, new_body)
}
Testing:
> f <- function_creater(name = "y", y_min = 2, y_max = 3)
> f
function (y)
(y >= 2 && y <= 3)
<environment: 0x000000001af5f518>
There are better ways to do this, but there's also the poor man's method: create a string with code and parse/eval it. I'm using glue for readability, but the same thing could be done with paste.
library(glue)
function_creator <- function(name = 'y', y_min = 2, y_max = 3){
code_string <-
glue('
function({name}){{
{name} >= {y_min} && {name} <= {y_max}
}}
')
eval(parse(text = code_string))
}
f <- function_creator(name = 'bob', y_min = 10, y_max = 20)
f(bob = 11) # TRUE
f(bob = 8) # FALSE
Note: With glue, objects within {} are evaluated and the result replaces the {}, e.g. '{name}' is replaced with 'y' within the string. Because of this substitution method, actual {s and }s need an extra { or } to escape.
Or, using the method of #Adam
library(rlang)
function_creator <- function(name, y_min, y_max){
new_function(pairlist2(name = ),
expr((!!sym(name) >= !!y_min && !!sym(name) <= !!y_max)))
}
function_creator(name = "y", y_min = 2, y_max = 3)
#> function (name)
#> (y >= 2 && y <= 3)
#> <environment: 0x7f8d0eeda028>
Created on 2021-12-05 by the reprex package (v2.0.1)
Related
In an S3 generic function, I'd like to modify a function argument before calling NextMethod(). As a starting point, I looked through #44 of Henrik Bengtsson's "Wishlist for R". The following snippet is taken from there and corresponds to his suggestion on to how modify an argument before calling NextMethod().
x <- structure(NA, class = "A")
expected <- list(x = x, a = 3)
foo <- function(x, a) UseMethod("foo")
foo.A <- function(x, a) {
a <- a + 1
NextMethod()
}
foo.default <- function(x, a) {
list(x = x, a = a)
}
identical(foo(x, a = 2), expected)
#> [1] TRUE
identical(foo(x, 2), expected)
#> [1] TRUE
Now what has me stumped is the following behavior where the argument to be modified has a default value.
bar <- function(x, a) UseMethod("bar")
bar.A <- function(x, a = 2) {
a <- a + 1
NextMethod()
}
bar.default <- function(x, a = 2) {
list(x = x, a = a)
}
identical(bar(x, a = 2), expected)
#> [1] TRUE
identical(bar(x, 2), expected)
#> [1] TRUE
identical(bar(x), expected)
#> [1] FALSE
Can someone help me understand what is happening here? Any ideas on how to make the default argument case work (apart from an explicit call of bar.default())?
I'm not sure how realistic this set-up is, but the problem with it is that calling bar(x) means that you are calling bar.A(x), then (via NextMethod()) you are calling bar.default(x), rather than bar.default(x, a = 3) as you might expect.
The way round this is to specifically pass a as a parameter in NextMethod. The issue you will have with this is that if the user doesn't name the second parameter, then bar.default will throw because it is being given 3 parameters instead of two (x, 2 and a = 3). You can get round this by including a ... parameter in bar.default so that unnamed parameters are ignored.
x <- structure(NA, class = "A")
expected <- list(x = x, a = 3)
bar <- function(x, ...) UseMethod("bar")
bar.A <- function(x, a = 2) {
a <- a + 1
NextMethod("bar", x, a = a)
}
bar.default <- function(x, ..., a = 2) {
list(x = x, a = a)
}
identical(bar(x, a = 2), expected)
#> [1] TRUE
identical(bar(x, 2), expected)
#> [1] TRUE
identical(bar(x), expected)
#> [1] TRUE
Created on 2020-04-02 by the reprex package (v0.3.0)
My goal is to create the following function using code:
s <- c(x = 10)
a <- c(i = 3)
model <- function(s, a) {
with(as.list(c(s, a)), {
y <- x * i
y * 10
})
}
model(s, a)
The result should be 300.
I'm parsing another software, and I can extract the equations from that software as strings. So, I need to construct the function's body from those strings.
I've been trying to use rlang library to no avail.
library(rlang)
func_body <- "with(as.list(c(s, a)), {
y <- x * i
y * 10
})";
foo <- new_function(
exprs(s =, a = ),
expr(!!parse(text = func_body))
)
Any idea?
Not sure your motivation for using new_function here but this gives your expected output:
library(rlang)
s <- (x = 10)
a <- (i = 3)
foo <- new_function(
args = pairlist2(s =, a =),
body = expr(
with(as.list(c(s, a)), {
y <- x * i
y * 10
})
)
)
foo(s, a)
#[1] 300
If the body is a string use parse_expr:
foo2 <- new_function(
args = pairlist2(s =, a =),
body = parse_expr(
"with(as.list(c(s, a)), {
y <- x * i
y * 10
})"
)
)
foo2(s, a)
#[1] 300
With base R you can do :
foo <- function(s, a){}
body(foo) <- parse(text=func_body)
foo(s, a)
#> [1] 300
An alternative way, still in base R would be:
foo <- as.function(c(alist(s=,a=), parse(text=func_body)[[1]]))
foo(s, a)
#> [1] 300
As a side note, in your example the values of s and a are not use at all, you're just using the values of x and i from the global workspace. You might want :
# cleanup
rm(s,a,x,i)
s <- c(x = 10)
a <- c(i = 3)
foo(s, a)
#> [1] 300
I tried to create a function f and create the function so when a value x is inserted, it spits out a function f from y.But, when I try to run the code to plot, it gives me an error that says that my y_value has no length.
f <- function(x){
if (x<0){
print(y_values<-x*x*x)
}
if(x>0 & x<=1){
print(y_values<-x*x)
}
if(x>1){
print(y_values<-sqrt(x))
}
}
x_values <- seq(-2, 2, by = 0.1)
y_values <- rep(NA, length(x_values))
for (i in seq_along(x_values)) {
x <- x_values[i]
y_values[i] <- f(x)
}
# output
plot(x_values, y_values, type = "l")
Two issues:
From ?print
‘print’ prints its argument and returns it invisibly (via
‘invisible(x)’)
So all your function f does is print the values to the console (instead of returning them).
As per your definition of f, the function does not know how to deal with x=0; so this will create a problem when you store the output of f(0) later.
We can fix these issues by slightly altering f as
f <- function(x) {
y_values <- NA
if (x<0){
y_values<-x*x*x
}
if(x>0 & x<=1){
y_values<-x*x
}
if(x>1){
y_values<-sqrt(x)
}
return(y_values)
}
Then
x_values <- seq(-2, 2, by = 0.1)
y_values <- rep(NA, length(x_values))
for (i in seq_along(x_values)) {
x <- x_values[i]
y_values[i] <- f(x)
}
plot(x_values, y_values, type = "l")
You could also use Vectorize to obtain a vectorised function f2, which allows you to pass x_values as a vector, thereby avoiding the explicit for loop:
f2 <- Vectorize(f)
x_values <- seq(-2, 2, by = 0.1)
y_values <- f2(x_values)
The resulting plot is the same.
I would recommend you explore other methods for coding something like this:
here is one option that doesn't use a for loop. If you are simply working on using for loops then the fix Mauritus Evers made should work for you.
library(tidyverse)
data.frame(x_values = seq(-2, 2, by = 0.1)) %>%
mutate(y_values = case_when(x_values < 0 ~ x_values^3,
x_values>=0 & x_values<=1 ~ x_values^2,
x_values>1 ~ sqrt(x_values))) %>%
ggplot(aes(x_values, y_values)) + geom_point()
note that I changed your code to produce output when x_value = 0.
I am using the data.table package to return a list of function closures in a j expression as output by the approxfun function from the stats package. Basically, on each Date, I would like a closure that allows me to calculate an arbitrary yval based on an arbitrary xval as determined by approxfun.
However, approxfun is only valid when there are at least two unique values of x passed to the function. In the case where there is only one unique value of x, I would like to return a function that returns the one unique value of y.
In the code below, I perform this step by check the .N value and returning a different function depending on whether or not .N is > 1.
library(data.table)
set.seed(10)
N <- 3
x <- data.table(Date = Sys.Date() + rep(1:N, each = 3), xval = c(0, 30, 90), yval = rnorm(N * 3))
x <- x[-c(2:3), ]
##interpolation happens correctly
x2 <- x[order(Date, xval), {
if(.N > 1){
afun <- approxfun(xval, yval, rule = 1)
}else{
afun <- function(v) yval
}
print(afun(30))
list(Date, afun = list(afun))
}, by = Date]
##evaluation does NOT happen correctly, the val used is the last...
sapply(x2[, afun], do.call, args = list(v = 30))
When evaluating the function 'afun' in the context of the j expression, the correct value of 'yval' is printed. However, when I go back after the fact to evaluate the first function, the yval returned is the last yval in the group created by the 'by' grouping for the function that is not created by approxfun (all the closures created by approxfun work as expected).
My suspicion is that this has to do with something I am missing with lazy evaluation. I tried the additional code below using the 'force' function but was unsuccessful.
x3 <- x[order(Date, xval), {
if(.N > 1){
afun <- approxfun(xval, yval, rule = 1)
}else{
fn <- function(x){
force(x)
function(v) x
}
afun <- fn(yval)
}
print(afun(30))
list(Date, afun = list(afun))
}, by = Date]
sapply(x3[, afun], do.call, args = list(v = 30))
Has anyone else encountered this issue? Is it something I am missing with base R or something I am missing with data.table?
Thanks in advance for the help
Yes, typical data.table reference vs copy FAQ. This works as expected:
x2 <- x[order(Date, xval), {
if(.N > 1){
afun <- approxfun(xval, yval, rule = 1)
}else{
fn <- function(){
#ensure the value is copied
x <- copy(yval)
function(v) x
}
afun <- fn()
}
print(afun(30))
list(Date, afun = list(afun))
}, by = Date]
#[1] 0.01874617
#[1] 0.2945451
#[1] -0.363676
sapply(x2[, afun], do.call, args = list(v = 30))
#[1] 0.01874617 0.29454513 -0.36367602
When you want to use R functions in VBA via RExcel, you have to use
RInterface.RRun "..."
Then, if you'd like to define your own R function, you can simply
RInterface.RRun "y <- function(x) { ... }"
If y is made up by more than one command line, you can separate each line with ;, as you're used to do in R environment.
But... what if your y function is very very long?
A 20 ~ 30 rows R function is damn difficult to be written in such a way in VBA; and there's a limit to the length of VBA sentences.
So: how may I wrap?
Here's an example of a quite long R function: can you show me how to put in VBA using RExcel?
bestIV <- function(dT, IVTS.t, Spot, r) {
b <- r
xout <- seq(0, max(T), dT)
sfm <- matrix(NA, nrow = length(K), ncol = length(xout))
for(i in 1:length(K)) {
sfm[i,] <- approx(x = T, y = IVTS.t[i,], xout = xout, rule = 2)$y
}
sfm[,1] <- sfm[,1] + sfm[,2] - sfm[,3]
rownames(sfm) <- K
colnames(sfm) <- xout
Option <- matrix(NA, nrow = length(K), ncol = length(xout))
for(i in 1:length(K)) {
for(j in 1:length(xout)) {
TypeFlag <- ifelse(K[i] < Spot, 'p', 'c')
Option[i,j] <- GBSOption(TypeFlag = TypeFlag, S = Spot, X = K[i],
Time = xout[j] / 365, r = r, b = b,
sigma = sfm[i,j] / 100)#price
}
}
rownames(Option) <- K
colnames(Option) <- xout
dP <- (cbind(0, -t(apply(X = Option, MARGIN = 1, FUN = diff))) / Option)[,-(1:2)]
dV <- dP / dT
min.V <- which(dV == min(dV), arr.ind = TRUE, useNames = TRUE)
Strike <- as.numeric(dimnames(min.V)[1])
Maturity <- as.numeric(unlist(dimnames(dV)[2]))[min.V[2]]
Days <- dT
Mat <- c(dV[which(dV == min(dV))], Strike, Maturity, Days)
names(Mat) <- c('Value', 'Strike', 'Maturity', 'Days')
return(Mat)
}
Thanks,
Put your R code in your spreadhseet (in a range of cells) and use this function instead:
RInterface.RunRCodeFromRange range
Executes the commands in range on a worksheet
(allows to use commands prepared for interactive execution with R to be run in macro code)
You are passing a string as an argument to a VBA function. Thus your question reduces to "how can I concatenate strings in VBA".
The answer is to use the concatenation operator &, like this:
"a" & "b"
Say you have an R function:
y <- function(x, a, b){
return(x)
}
Then you can do this in VBA:
RInterface.RRun "y <- function(x, a, b) {" &
"return(x)" &
"}"