I'm trying to write a let function that allows me to do things like:
let(a=2, b=3, a+b)
>>> 5
Currently I'm stuck with
let <- function(..., expr) {
with(list(...), quote(expr))
}
which doesn't work at all. Any help appreciated.
Here's one way:
let <- function(..., expr) {
expr <- substitute(expr)
dots <- list(...)
eval(expr, dots)
}
let(a = 2, b = 3, expr = a+b)
# [1] 5
Edit: Alternatively, if you don't want to have to name the expression-to-be-evaluated (i.e. passing it in via expr), and if you are certain that it will always be the last argument, you could do something like this.
let <- function(...) {
args <- as.list(sys.call())[-1]
n <- length(args)
eval(args[[n]], args[-n])
}
let(a = 2, b = 3, a + b)
# [1] 5
let <- function(a,b, expr=a+b){return(expr)}
let(2,3)
# [1] 5
Related
I have two functions, as for example:
a <- function(x) return(mean(x))
b <- function(x) return(median(x))
I would like to have another function that passes either a or b as an argument.
The goal is something like this:
oper <- function(f, x) {
ifelse(f == "a", a(x), b(x))
}
If for example I was to execute the function:
oper(a, c(3,4,5))
I get the following error message:
Error in f == "a" :
comparison (1) is possible only for atomic and list types
Disclosure: mean(x) and median(x) are just for example purposes.
Because R has first-class functions, you can simply pass your function and call it directly:
oper2 <- function(f, x) {
f(x)
}
x <- c(2, 3, 8)
oper2(a, x)
# 4.333333
oper2(b, x)
# 3
Similar to the question here. Given a function f with named arguments and a function g taking any number of arguments through ..., how would one
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f()
Error in g(a = a) : argument "a" is missing, with no default
rlang::dots_list sadly did not provide an answer
f2 <- function(a)
h(a = a)
h <- function(...)
rlang::dots_list(..., .ignore_empty = 'all')
f2()
Error in eval(expr, p) : argument "a" is missing, with no default
Edit:
To make the problem more clear, the function g may be called by a myriad of functions, and I'm looking for a way to handle the missing arguments within g and not f.
You can forward ... to subfunctions to multiple depths without evaluating them as long as the subfunctions don't actually perform any evaluation themselves so you don't have to handle this in all functions that receive ... but at the point where it is evaluated you will need to deal with it somehow.
Assuming that f() should return a empty list handle the missing argument separately within g
f <- function(a) g(a = a)
g <- function(..., default = list()) if (missing(..1)) default else list(...)
f()
## [1] list()
or the following which checks each element of ... :
g <- function(..., default = list()) {
L <- list()
for(i in seq_len(...length())) {
x <- try(eval.parent(list(...)[[i]]), silent = TRUE)
L[[i]] <- if (inherits(x, "try-error")) default else x
}
names(L) <- names(substitute(alist(...))[-1])
L
}
f()
## $a
## list()
or within f:
f <- function(a) if (missing(a)) g() else g(a = a)
g <- function(...) list(...)
f()
## [1] list()
Your code seems to be OK except you call f() without a argument at the end... try this:
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f("example")
Or you have to provide a default value for a:
f <- function(a = "example")
g(a = a)
g <- function(...)
list(...)
f()
So the problem is not a missing argument in g(...), but missing argument value in f() when calling g(a = a) without having a.
Hi so I have the following function:
kde.cv = function(X,s) {
l = length(X)
log.fhat.vector = c()
for (i in 1:l) {
current.log.fhat = log ( kde(X[i],X[-i],s) )
log.fhat.vector[i] = current.log.fhat
}
CV.score = sum(log.fhat.vector)
return(CV.score)
}
I'd like to vectorize this without using any for loops or apply statements, can't seem to get around doing so. Help would be appreciated. Thanks.
EDIT: Given the responses, here are my answers to the questions posed.
Given requests for clarification, I will elaborate on the function inputs and on the user defined function inside the function given. So X here is a dataset in the form of a vector, specifically, a vector of length 7 in the dataset I used as an input to this function. The X I used this function for is c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041). s is a single scalar point set at 0.2 for the use of this function. kde is a user - defined function that I wrote. Here is the implementation:
kde = function(x,X,s){
l = length(x)
b = matrix(X,l,length(X),byrow = TRUE)
c = x - b
phi.matrix = dnorm(c,0,s)
d = rowMeans(phi.matrix)
return(d)
}
in this function, X is the same vector of data points used in kde.cv. s is also the same scalar value of 0.2 used in kde.cv. x is a vector of evaluation points for the function, I used seq(-2.5, -0.5, by = 0.1).
Here is an option using sapply
kde.cv = function(X,s)
sum(sapply(1:length(X), function(i) log(kde(X[i], X[-i], s))))
For convenience, please provide a more complete example. For example, the kde() function. Is that a customized function?
Alternative to sapply, you can try Vectorize(). There are some examples you can find on stack overflow.
Vectorize() vs apply()
Here is an example
f1 <- function(x,y) return(x+y)
f2 <- Vectorize(f1)
f1(1:3, 2:4)
[1] 3 5 7
f2(1:3, 2:4)
[1] 3 5 7
and the second example
f1 <- function(x)
{
new.vector<-c()
for (i in 1:length(x))
{
new.vector[i]<-sum(x[i] + x[-i])
}
return(sum(new.vector))
}
f2<-function(x)
{
f3<-function(y, i)
{
u<-sum(y[i]+y[-i])
return(u)
}
f3.v<-Vectorize(function(i) f3(y = x, i=i))
new.value<-f3.v(1:length(x))
return(sum(new.value))
}
f1(1:3)
[1] 24
f2(1:3)
[1] 24
Note: Vectorize is a wrapper for mapply
EDIT 1
According to the response, I edited your kde.cv function.
kde.cv = function(X,s) {
l = length(X)
log.fhat.vector = c()
for (i in 1:l) {
current.log.fhat = log ( kde(X[i],X[-i],s) )
log.fhat.vector[i] = current.log.fhat
}
CV.score = sum(log.fhat.vector)
return(CV.score)
}
kde = function(x,X,s){
l = length(x)
b = matrix(X,l,length(X),byrow = TRUE)
c = x - b
phi.matrix = dnorm(c,0,s)
d = rowMeans(phi.matrix)
return(d)
}
##### Vectorize kde.cv ######
kde.cv.v = function(X,s)
{
log.fhat.vector = c()
kde.v<-Vectorize(function(i) kde(X[i], X[-i], s))
CV.score <- sum(log(kde.v(1:length(X))))
return(CV.score)
}
X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2
x<-seq(-2.5, -0.5, by = 0.1)
kde.cv(X, s)
[1] -10.18278
kde.cv.v(X, s)
[1] -10.18278
EDIT 2
Well, I think the following function may match your requirement. BTW, since the little x is not used in your kde.cv, I just edited both two functions
kde.cv.2 <- function(X,s)
{
log.fhat.vector<-log(kde.2(X, s))
CV.score = sum(log.fhat.vector)
return(CV.score)
}
kde.2<-function(X, s)
{
l <- length(X)
b <- matrix(rep(X, l), l, l, byrow = T)
c <- X - b
diag(c) <- NA
phi.matrix <- dnorm(c, 0, s)
d <- rowMeans(phi.matrix, na.rm = T)
return(d)
}
X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2
kde.cv(X,s)
[1] -10.18278
kde.cv.2(X, s)
[1] -10.18278
This question refers to "Programming with dplyr"
I want to slice the ... argument of a function and use each element as an argument for a corresponding function.
foo <- function(...){
<some code>
}
should evaluate for example foo(x, y, z) in this form:
list(bar(~x), bar(~y), bar(~z))
so that x, y, z remain quoted till they get evaluated in bar.
I tried this:
foo <- function(...){
arguments <- quos(...)
out <- map(arguments, ~bar(UQ(.)))
out
}
I have two intentions:
Learn better how tidyeval/rlang works and when to use it.
turn future::futureOf() into a function that get me more then one futures at once.
This approach might be overly complicated, because I don't fully understand the underlying concepts of tidyeval yet.
You don't really need any packages for this. match.call can be used.
foo <- function(..., envir = parent.frame()) {
cl <- match.call()
cl$envir <- NULL
cl[[1L]] <- as.name("bar")
lapply(seq_along(cl)[-1], function(i) eval(cl[c(1L, i)], envir))
}
# test
bar <- function(...) match.call()
foo(x = 1, y = 2, z = 3)
giving:
[[1]]
bar(x = 1)
[[2]]
bar(y = 2)
[[3]]
bar(z = 3)
Another test
bar <- function(...) ..1^2
foo(x = 1, y = 2, z = 3)
giving:
[[1]]
[1] 1
[[2]]
[1] 4
[[3]]
[1] 9
I am trying to create new functions from a list of function and a list of parameters to be passed to these functions, but am unable to do so so far. Please see the example below.
fun_list <- list(f = function(x, params) {x+params[1]},
z = function(a, params) {a * params[1] * params[2]})
params_list <- list(f = 1, z = c(3, 5))
# goal is to create 2 new functions in global environment
# fnew <- function(x) {x+1}
# znew <- function(a) {a*3*5}
# I've tried
for(x in names(fun_list)){
force(x)
assign(paste0(x, "new"), function(...) fun_list[[x]] (..., params = params_list[[x]]))
}
The goal is to do this dynamically for arbitrary functions and parameters.
Well, force() doesn't work in a for-loop because for loops do not create new environments. Based on a previous question of mine, I created a capture() function
capture <- function(...) {
vars <- sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
this allows
for(x in names(fun_list)) {
f = local({
capture(x);
p = params_list[[x]];
f = fun_list[[x]];
function(x) f(x, p)
})
assign(paste0(x, "new"), f)
}
where we create a local, private environment for the functions to store their default parameter values.
Which gives
fnew(2)
# [1] 3
znew(2)
# [1] 30
How about this:
for(x in names(fun_list)) {
formals(fun_list[[x]])$params <- params_list[[x]]
assign(paste0(x, "new"), fun_list[[x]])
}
This is similar in spirit:
ps <- list(fp=1,zp=c(3,5))
f0s <- substitute(list(f=function(x)x+fp,z=function(a)a*zp1*zp2),as.list(unlist(ps)))
f0s # list(f = function(x) x + 1, z = function(a) a * 3 * 5)
fs <- eval(f0s)
fs$f(1) # 2
To do the fancy thing described in the OP, you'd probably have to mess with formals.