Modify a function call captured in exp - r

For example, changing cumsum in the output of expr(cumsum(1:3)) to cumprod.
Currently the only thing I can think of is converting the output of expr(cumsum(1:3)) to a string, editing it, then changing it back to a function call.
This seems like a pretty poor solution though and I'm struggling to find a better way.
library(rlang)
f(expr(cumsum(1:4)), cumprod)
# [1] 1 2 6 24
This is basically what I'm trying to achieve. Can you help me find a starting point?

If you just apply gsub to expression R casts it to character vector and does the substitution which you can cast as expression with parse:
y <- 1:4
x <- expression({cumsum(y)})
x.2 <- gsub("cumsum", "cumprod", x)
class(x.2)
# [1] "character"
x.2 <- parse(text = x.2)
eval(x)
# [1] 1 3 6 10
eval(x.2)
# [1] 1 2 6 24

Here is an option using rlang
f <- function(ex, fn) {
ex1 <- as.character(ex)
fn <- enquo(fn)[-1]
eval_tidy(parse_expr(glue::glue('{fn}({ex1[-1]})')))
}
f(expr(cumsum(1:4)), cumprod)
#[1] 1 2 6 24

Note that if you replaced cumsum with cumprod the output would be a vector 4 long, not 24, so we assume you meant to replace it with prod.
We use substitute to substitute cumsum with the value of the cumsum argument and then evaluate the resulting expression.
f here uses no packages -- the input in the question uses expr from rlang but even that is not really needed since we could have used quote(...) in place of expr(...).
f <- function(.x, cumsum) eval.parent(do.call("substitute", list(.x)))
# test
f(expr(cumsum(1:4)), prod)
## [1] 24
f(expr(cumsum(1:4)), cumprod)
## [1] 1 2 6 24

I like #David Arenburg, so I'm posting his answer here and marking it.
It's not clear to me how do you decide which function you want replace (because : is also a function). But if you want to always replace the outer one, you could define the following
function f <- function(x, y) {
tmp <- substitute(x)
tmp[[1]] <- substitute(y)
eval(tmp)
}
and then use it as follows
f(cumsum(1:4), cumprod)
#[1] 1 2 6 24
– David Arenburg

Related

data.table CJ with string as input

How can the CJ-command be run with string as input? The following MNWE illustrates what is needed:
library(data.table)
# This is the desired output (when needed.cols==2)
dt.wanted <- CJ(X.1=c(1L, 2L), X.2=c(1L, 2L))
# Here is an example with needed.cols as variable
needed.cols <- 2L
use.text <- paste0("X.", 1L:needed.cols, "=c(1L, 2L)", collapse=", ")
# Here are some failing attempts
dt.fail <- CJ(use.text)
dt.fail <- CJ(eval(use.text))
dt.fail <- CJ(get(use.text))
So it is the use.text I want to make scriptable (because it varies, not only with needed.cols).
IIUC, you are looking for a function to pass a list of arguments into ... of a function. You can do it using do.call as follows:
do.call(CJ, eval(parse(text=paste0("list(",use.text,")"))))
Hope that is what you are looking for...
The get-function is the standard way of promoting a character value to a true R name value.
Is this what you want:
col.wanted =2
dt.wanted[ , get(paste0("X.", col.wanted) )]
#[1] 1 2 1 2
Getting multiple columns based on evaluation of a more complex expression might require somewhat more baroque efforts:
> use.text <- paste0("list(", paste0("X.", 1L:needed.cols, collapse=", "),")")
> use.text
[1] "list(X.1, X.2)"
> dt.wanted[ , eval(use.text)]
[1] "list(X.1, X.2)"
> dt.wanted[ , parse(text=use.text)]
expression(list(X.1, X.2))
> dt.wanted[ , eval(parse(text=use.text))]
X.1 X.2
1: 1 1
2: 1 2
3: 2 1
4: 2 2

Regex in R lists to call specific function

It is of course possible to store functions in a list to call it.
It is also possible to name that list entry to have a better access to it later.
Now I need the list item name to be a regular expression like this:
funcList <- list("^\\+[0-9]{1,3}$"=lead, "^\\-[0-9]{1,3}$"=lag)
a <- funcList$"+12"(a,12) # this will fire function "lead"
a <- funcList$"-4"(a,-4) # this will fire function "lag"
a <- funcList$"^\\+[0-9]{1,3}$"(a,12) # this works of course but is not what I want...
Of course this is not working correctly and I am getting the error "Error: attempt to apply non-function" because it is not used as regex but as a normal string value.
Is it possible to do what I need?
You could use the names of the array as parameters for grepl:
funcList <- list("^\\+[0-9]{1,3}$"=lead, "^\\-[0-9]{1,3}$"=lag)
f1 <- funcList[sapply(names(funcList), function(x) grepl(x,"+12"))][[1]]
f2 <- funcList[sapply(names(funcList), function(x) grepl(x,"-4"))][[1]]
> f1(seq(1,10))
[1] 2 3 4 5 6 7 8 9 10 NA
> f2(seq(1,10))
[1] NA 1 2 3 4 5 6 7 8 9
I think you can map strings like "+4" and "-12" to lead/lag more straightforwardly like:
set.seed(123)
df = data.frame(
x = sample(1:20, 10)
)
shifted = function(x, shift) {
direction = substr(shift, 1, 1)
amount = as.integer(substr(shift, 2, nchar(shift)))
if (direction == "+") {
return(lead(x, amount))
} else {
return(lag(x, amount))
}
}
df %>%
mutate(
plus4 = shifted(x, "+4"),
minus3 = shifted(x, "-3")
)
You could use regex within the shifted function if you need to do more validation of the "+4" strings, but I prefer not to go for complicated regexes unless they're definitely needed.

Call an object using a function in R

I have R objects:
"debt_30_06_2010" "debt_30_06_2011" "debt_30_06_2012" ...
and need to call them using a function:
paste0("debt_",date) ## "date" being another object
The problem is that when I assign the call to another object it takes only the name not the content:
debt_a <- paste0("endeud_", date1)
> debt_a
[1] "debt_30_06_2014"
I've tried to use the function "assign" without success:
assign("debt_a", paste0("debt_", date))
> debt_a
[1] "debt_30_06_2014"
I would like to know there is any method to achieve this task.
We could use get to get the value of the object. If there are multiple objects, use mget. For example, here I am assigning 'debt_a' with the value of 'debt_30_06_2010'
assign('debt_a', get(paste0('debt_', date[1])))
debt_a
#[1] 1 2 3 4 5
mget returns a list. So if we are assigning 'debt_a' to multiple objects,
assign('debt_a', mget(paste0('debt_', date)))
debt_a
#$debt_30_06_2010
#[1] 1 2 3 4 5
#$debt_30_06_2011
#[1] 6 7 8 9 10
data
debt_30_06_2010 <- 1:5
debt_30_06_2011 <- 6:10
date <- c('30_06_2010', '30_06_2011')
I'm not sure if I understood your question correctly, but I suspect that your objects are names of functions, and that you want to construct these names as characters to use the functions. If this is the case, this example might help:
myfun <- function(x){sin(x)**2}
mychar <- paste0("my", "fun")
eval(call(mychar, x = pi / 4))
#[1] 0.5
#> identical(eval(call(mychar, x = pi / 4)), myfun(pi / 4))
#[1] TRUE

Using apply and multi argument functions

I want to apply a function over a data frame. The function takes V1 as arg1 and V2 as arg2 and I want to write the result to V3 or some other vector.
Is there an easy and compact way to do this? I've posted a (non-working) example below.
Thanks
Stu
my.func <- function(X, Y) {
return(X + Y)
}
a <- c(1,2,3)
b <- c(4,5,6)
my.df <- data.frame(a, b)
apply(my.df, 1, my.func, X="a", Y="b")
mapply() is made for this.
Either of the following will do the job. The advantage of the second approach is that it scales nicely to functions that take an arbitrary number of arguments.
mapply(my.func, my.df[,1], my.df[,2])
# [1] 5 7 9
do.call(mapply, c(FUN=list(my.func), unname(my.df)))
# [1] 5 7 9
I feel this would be better approached using with than mapply if you're calling elements inside a data.frame:
with(my.df,my.func(X=a,Y=b))
#[1] 5 7 9
It's still quite a clean method even if you need to do the explicit conversion from a matrix:
with(data.frame(my.mat),my.func(X=a,Y=b))
#[1] 5 7 9
There isn't really any need for an *apply function here. Vectorization would suffice:
my.df$c <- my.df$a + my.df$b
# a b c
#1 1 4 5
#2 2 5 7
#3 3 6 9
Your apply solution can't work the way you have written it because apply does not pass a named vector through to your function: e.g.
colnames(my.df)
#[1] "a" "b"
apply( my.df , 1 , colnames )
#NULL
For your example, rowSums(my.df) will do the job. For more complicated tasks, you can use the mapply function. For example: mapply(my.func, my.df[a], my.df[b]).
Alternatively, you could rewrite your function to take a vector argument:
my.otherfunc <- function(x) sum(x)
apply(my.df, 1, my.otherfunc)
It's important to understand that when apply feeds each row or column into the function, it's sending one vector, not a list of separate entries. So you should give it a function with a single (vector) argument.

How Can I vectorize this function to return an index vector?

I'm new to R and am trying to get a handle on the apply family of functions. Specifically, I am trying to write a higher-order function that will accept 2 character vectors, "host", and "guest" (which do not need to be the same length) and return me an index vector the same length as "host", with the resulting elements corresponding to their indices in guest (NA if not there).
host <- c("A","B","C","D")
guest <- c("D","C","A","F")
matchIndices <- function(x,y)
{
return(match(x,y))
}
This code returns 3 as expected:
matchIndices(host[1],guest)
This is the loop I'd like to be able to replace with a succinct apply function (sapply?)
for (i in 1:length(host))
{ idx <- matchIndices(host[i],guest);
cat(paste(idx,host[i],"\n",sep=";"))
}
This code "works" in that it produces the output below, but I really want the result to be a vector, and I have a hunch that one of the apply functions will do the trick. I'm just stuck on how to write it. Any help would be most appreciated. Thanks.
3;A;
NA;B;
2;C;
1;D;
host <- c("A","B","C","D")
guest <- c("D","C","A","F")
matchIndices <- function(x,y) {
return(match(x,y))
}
One (inefficient) way is to sapply over the host vector, passing in guest as an argument (note you could just simplify this to sapply(host, match, guest) but this illustrates a general way of approaching this sort of thing):
> sapply(host, matchIndices, guest)
A B C D
3 NA 2 1
However, this can be done directly using match as it accepts a vector first argument:
> match(host, guest)
[1] 3 NA 2 1
If you want a named vector as output,
> matched <- match(host, guest)
> names(matched) <- host
> matched
A B C D
3 NA 2 1
which could be wrapped into a function
matchIndices2 <- function(x, y) {
matched <- match(x, y)
names(matched) <- x
return(matched)
}
returning
> matchIndices2(host, guest)
A B C D
3 NA 2 1
If you really want the names and the matches stuck together into a vector of strings, then:
> paste(match(host, guest), host, sep = ";")
[1] "3;A" "NA;B" "2;C" "1;D"
if you want the output vector in the host;guestNum format you would use do.call, paste, match as follows:
> do.call(paste, list(host, sapply(host, match, guest), sep = ';'))
[1] "A;3" "B;NA" "C;2" "D;1"
sapply(host , function(x) which(guest==x))
$A
[1] 3
$B
integer(0)
$C
[1] 2
$D
[1] 1
unlist(sapply(host , function(x) which(guest==x)))
A C D
3 2 1
paste(host, sapply(host , function(x) which(guest==x)), sep=":", collapse=" ")
[1] "A:3 B:integer(0) C:2 D:1"

Resources