Assume I have a value x which is of some (unknown) type (especially: scalar, vector or list). I would like to get the R expression representing this value. If x == 1 then this function should simply return expression(1). For x == c(1,2)) this function should return expression(c(1,2)). The enquote function is quite near to that what I want, but not exactly.
By some playing around I found the following "solution" to my problem:
get_expr <- function(val) {
tmp_expr <- enquote(val)
tmp_expr[1] <- quote(expression())
return(eval(tmp_expr))
}
get_expr(1) # returns expression(1)
get_expr(c(1, 2)) # returns expression(c(1, 2))
get_expr(list(x = 1)) # returns expression(list(x = 1))
But I think my get_expr function is some kind of hack. Logically, the evaluation should not be necessary.
Is there some more elegant way to do this? As far as I see, substitute does not really work for me, because the parameter of my get_expr function may be the result of an evaluation (and substitute(eval(expr)) does not do the evaluation).
I found another way via parse(text = deparse(val)), but this is even more a bad hack...
as.expression(list(...)) seems to do it:
> get_expr <- function(val) as.expression(list(val))
> str(get_expr(1))
expression(1)
> str(get_expr(c(1, 2)))
expression(c(1, 2))
> str(get_expr(list(x=1)))
expression(list(x = 1))
> val <- list(x=1, y=2)
> str(get_expr(val))
expression(list(x = 1, y = 2))
You can use substitute(), and just need to call it a bit differently:
express <- function(e) substitute(expression(x), env = list(x=e))
v1 <- c(1, 2)
express(v1)
# expression(c(1, 2))
v2 <- list(a = 1, b = 2)
express(v2)
# expression(list(a = 1, b = 2))
Related
This question is a follow up on two questions I had answered before:
Create the function
Calculate mean
I have a couple of variables (var1, var2 and var3), which have different distribution functions:
var1_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 3, sd = 1))
var1_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 6, sd = 1))
var1_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 2, sd = 2))
var2_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 5, sd = 3))
var2_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 3, sd = 1))
var2_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 4, sd = 2))
var3_distr1 <- pdqr::as_d(function(x)dnorm(x, mean = 4, sd = 1))
var3_distr2 <- pdqr::as_d(function(x)dnorm(x, mean = 5, sd = 1))
var3_distr3 <- pdqr::as_d(function(x)dnorm(x, mean = 7, sd = 2))
To create proportional distribution function, to match the combination of two or three different variables whith their appropriate probablity functions I have created the next function I learned in the first question:
foo <- function(...){
#set x values
x <- seq(1, 10, by = 1)
#create y values
y <- 1L
for (fun in list(...)) y <- y * fun(x)
#create new PDF
p <- data.frame(x,y)
pdqr::new_d(p, type = "continuous")
}
So, if I want to create a proportional distribution function var2_distr1__var3_distr3 of var2_distr1 and var3_distr3 I can just do this: var2_distr1__var3_distr3 <- foo(var2_distr1, var3_distr3), works like charm.
Now I have per for each variable, per case, I have selected the appropriate distrubution, using a simple if_else, which returns the appropriate distribution in a dataframe like this:
df <- data.frame(var1 = c("var1_distr1", "var1_distr3", "var1_distr1", "var1_distr2", "var1_distr2", "var1_distr1", "var1_distr3"),
var2 = c("var2_distr2", "var2_distr1", "var2_distr2", "var2_distr1", "var2_distr3", "var2_distr3", "var2_distr1"),
var3 = c("var3_distr2", "var3_distr3", "var3_distr1", "var3_distr1", "var3_distr2", "var3_distr3", "var3_distr1"))
If I want the mean for the relavant individual distributions per case for a single variable I can use this
df$var2_distr1_mean <- sapply(mget(df$var2_distr1), pdqr::summ_mean)
df$var3_distr3_mean <- sapply(mget(df$var3_distr3), pdqr::summ_mean)
which I learned in the second question.
However, if I want to get the mean of the proportional distributions given in var1 and var2 I get into trouble.
> df$var1_2_mean <- mapply(pdqr::summ_mean, foo(df$var1, df$var2))
Error in fun(x) : could not find function "fun"
While if I individually pass the distribution functions, this happens:
> df$var1_2_mean <- mapply(summ_mean, foo(var1_distr1, var2_distr2))
Error in dots[[1L]][[1L]] : object of type 'closure' is not subsettable
As suggested by #Limey, if put the PDF's in a list:
PDFS <- list(var1_distr1 = var1_distr1, var1_distr2 = var1_distr2, var1_distr3 = var1_distr3,
var2_distr1 = var2_distr1, var2_distr2 = var2_distr2, var2_distr3 = var2_distr3,
var3_distr1 = var3_distr1, var3_distr2 = var3_distr2, var3_distr3 = var3_distr3)
However, when calling that (using this approach apply-list-of-functions-to-list-of-values) I get this:
> df$var1_2_mean <- foo(sapply(PDFS, mapply, df$var1, df$var2))
Error in (function (x) : unused argument (dots[[2]][[1]])
> sapply(PDFS, mapply, df$var1, df$var2)
Error in (function (x) : unused argument (dots[[2]][[1]])
> sapply(PDFS, mapply, df$var1)
Error: `x` must be 'numeric', not 'character'.
> df$var1_2_mean <- foo(sapply(PDFS, mapply, paste(df$var1, df$var2, sep = ", ")))
Error: `x` must be 'numeric', not 'character'.
> df$var1_2_mean <- summ_mean(foo(sapply(PDFS, mapply, paste(df$var1, df$var2, sep = ", "))))
Error: `x` must be 'numeric', not 'character'.
> df$var1_2_mean <- sapply(foo(mget(mapply(PDFS, sapply, df$var1, df$var2))), pdqr::summ_mean)
Error in get(as.character(FUN), mode = "function", envir = envir) :
object 'PDFS' of mode 'function' was not found
> lapply(PDFS, function(x) x())
Error in x() : argument "x" is missing, with no default
I'm still missing something, and I believe it's on vectorisation. Might invoke_map work?
I don't have the pdqr package, so I can't solve your exact problem, but here's a proof-of-concept example that may be helpful. As I mention in comments, you haven't specified your exact use case, but I do feel you are imposing constraints that make your life more difficult than it need be. For example passing function names rather than functions to your summary function, using a data frame rather than a list, etc.
Anyway, start by defining some functions and store them in a list.
foo1 <- function() {"Foo 1"}
foo2 <- function() {"Foo 2"}
foo3 <- function() {"Foo 3"}
funcList <- list(foo1, foo2, foo3)
Now use utils::combn() to generate all combinations of two of these three functions and call each member of each pair in turn.
combn(
funcList,
m=2,
FUN=function(combination) {
lapply(combination, function(x) x())
}
)
Giving
[,1] [,2] [,3]
[1,] "Foo 1" "Foo 1" "Foo 2"
[2,] "Foo 2" "Foo 3" "Foo 3"
combn() takes the list of functions as input. m=2 requests the generation of all combinations of 2 elements from the list. FUN= specifies a function to be applied to each combination. The anonymous function supplied simply takes the supplied combination and simply calls each element of the combination in turn.
I have a function
eval_ = function(f, i) f(i)
for a list of functions, say
fns = list(function(x) x**2, function(y) -y)
and a vector of integers, say
is = 1:2
I would like to get eval_ evaluated at all combinations of fns and is.
I tried the following:
cross = expand.grid(fns, is)
names(cross) = c("f", "i")
results = sapply(1:nrow(cross), function(i) do.call(eval_, cross[i,]))
This throws an error:
Error in f(i) : could not find function "f"
I think that the underlying problem is, that cross is a data.frame and can not carry functions. Hence, it puts the function into a list and then carries a list (indeed, class(cross[1,][[1]]) yields "list". My ugly hack is to change the third line to:
results = sapply(
1:nrow(cross),
function(i) do.call(eval_, list(f = cross[i,1][[1]], i = cross[i,2]))
)
results
#[1] 1 -1 4 -2
This works, but it defeats the purpose of do.call and is very cumbersome.
Is there a nice solution for this kind of problem?
Note: I would like a solution that generalizes well to cases where the cross product is not only over two, but possibly an arbitrary amount of lists, e.g. functions that map R^n into R.
Edit:
For a more involved example, I think of the following:
fns = list(mean, sum, median)
is1 = c(1, 2, 4, 9), ..., isn = c(3,6,1,2) and my goal is to evaluate the functions on the cartesian product spanned by is1, ..., isn, e.g. on the n-dimensional vector c(4, ..., 6).
You can use mapply() for this:
eval_ <- function(f, i) f(i)
fns <- list(function(x) x**2, function(y) -y)
is <- 1:2
cross <- expand.grid(fns = fns, is = is)
cross$result <- mapply(eval_, cross$fn, cross$is)
print(cross)
#> fns is result
#> 1 function (x) , x^2 1 1
#> 2 function (y) , -y 1 -1
#> 3 function (x) , x^2 2 4
#> 4 function (y) , -y 2 -2
An attempt for my "more involved example" with n = 2.
Let X = expand.grid(c(1, 2, 4, 9), c(3,6,1,2)).
The following pattern generalizes to higher dimensions:
nfns = length(fns)
nn = nrow(X)
res = array(0, c(nfns, nn))
for(i in 1:nfns){
res[i,] = apply(X, MARGIN = 1, FUN = fns[[i]])
}
The shape of the margin of X (i.e. nrow(X)) must correspond to the shape of the slice res[i,] (i.e. nn). The function must map the complement of the margin of X (i.e. slices of the form X[i,]) to a scalar. Note that a function that is not scalar has components that are scalar, i.e. in a non-scalar case, we would loop over all components of the function.
I recently asked a similar question (link), but the example that I gave there was a little too simple, and the answers did not work for my actual use case. Again, I am using R and want to apply a function to a vector. The function returns a list, and I want the results to be formatted as a list of vectors, where the names of the output list correspond to the names in the list returned by the function, and the value for each list element is the vector of values over the elements of the input vector. The following example shows a basic set up, together with two ways of calculating the desired output (sum.of.differences and sum.of.differences.2). The first method (sum.of.differences) seems to be the easiest way to understand what the desired output; the second method (sum.of.differences.2) avoids two major problems with the first method -- computing the function twice for each element of the input vector, and being forced to give the names of the list elements explicitly. However, the second method also seems relatively complicated for such a fundamental task. Is there a more idiomatic way to get the desired results in R?
x <- rnorm(n = 10)
a <- seq(from = -1, to = +1, by = 0.01)
sum.of.differences.fun <- function(a) {
d <- x - a
list(
sum.of.absolute.differences = sum(abs(d)),
sum.of.squared.differences = sum(d^2)
)
}
sum.of.differences <- list(
sum.of.absolute.differences = sapply(
X = a,
FUN = function(a) sum.of.differences.fun(a)$sum.of.absolute.differences
),
sum.of.squared.differences = sapply(
X = a,
FUN = function(a) sum.of.differences.fun(a)$sum.of.squared.differences
)
)
sum.of.differences.2 <- (function(lst) {
processed.lst <- lapply(
X = names(lst[[1]]),
FUN = function(name) {
sapply(
X = lst,
FUN = function(x) x[[name]]
)
}
)
names(processed.lst) <- names(lst[[1]])
return(processed.lst)
})(lapply(X = a, FUN = sum.of.differences.fun))
What language did you learn before R? It seems as though you might be using design patterns from a different functional language (I'd guess Lisp). The following code is much simpler and the output is identical (aside from names) as far as I can tell.
x <- rnorm(n = 10)
a <- seq(from = -1, to = +1, by = 0.01)
funs <- c(
sumabsdiff = function(a) sum(abs(x - a)),
sumsquarediff = function(a) sum((x - a) ^ 2)
)
sumdiff <- lapply(
funs,
function(fun) sapply(a, fun)
)
Supposed I have an arbitrary function
foo = function(a,b) {a+b}
How can I iterate this function onto itself n times?
foo(foo(foo(foo(x, 1), 2), 3, 4)
I am looking at purrr:compose but it doesn't look hopeful for arbitrary n. purrr:reduce feels like it will come into play also... but I'm stumped.
Here is a pure purrr version, that is really functional, as you said reduce comes in handy here, since compose is just a function and functions are just elements you can reduce functions by composing them. To just fill one argument use partial.
foo_n <- reduce(map(1:n, ~partial(foo, b=.x)), compose)
You can also just append results of each foo(a,b) function into a numeric vector and then pick up the last result.
Let's x = 1 and bs are elements of 1:4:
x = 1
n = 4
out = vector("numeric")
steps = seq(1, 4, by = 1)
for( b in steps){
## initial value
if (length(out) == 0){
out = append(out, values = foo(x, b) )
}else{
out = append(out, values = foo( tail( out, 1), b) )
}
}
tail(out, 1)
I have an R function which takes a large number of arguments (18) which I would like to pass in as a list. When I am running this function by hand, so to speak, I generally want to use all the defaults but one or two, but I also want to run this same function many times with various combinations of default and non-default items, which I would like to assemble programmatically as lists.
I know that I could just have my 18+ arguments as individual formals and then assemble them into a list inside the function, but I wish I could have a list as a default for a formal, and then have the elements have defaults as well. Like this:
> f <<- function(x, y = list(a=0, b=3)) {with(y, (x + a + b))}
> f(1)
[1] 4
> f(x=1, y$a = 1)
Error: unexpected '=' in "f(x=1, y$a ="
(or alternatively)
In y$a <- 1 :
Error in eval(substitute(expr), data, enclos = parent.frame()) :
object 'a' not found
except with the output of 5 rather than an error. I suspect there is no way to do this, because R does not recognise the assignments in the list as creating defaults, but only as creating named elements. But maybe with the assignment form of formals? or through some clever use of do.call?
Here are some alternatives:
1) modifyList Use modifyList to process the defaults.
f1 <- function(x, y = list()) {
defaults <- list(a = 0, b = 3)
with(modifyList(defaults, y), {
x + a + b
})
}
f1(x = 1)
## [1] 4
f1(x = 1, y = list(a = 1))
## [1] 5
2) do.call Another possibility is to have two functions. The first does not use a list and the second (which is the one the user calls) does using do.call to invoke the first.
f2impl <- function(x, a = 0, b = 3) x + a + b
f2 <- function(x, y = list()) do.call("f2impl", c(x, y))
f2(x = 1)
## [1] 4
f2(x = 1, y = list(a = 1))
## [1] 5