I am trying to use furrr::future_pmap in R to replace purrr::pmap in a function call within another function.
Presently I have it set up so pmap is passing other arguments using the ellipsis ... however when I try and do this using future_pmap I get unused argument errors (see example below). I know from comments in here passing ellipsis arguments to map function purrr package, R and other previous research that for the ellipsis to work with pmap you need to use function(x,y,z) blah(x,y,z,...) instead of ~blah(..1,..2,..3) but the same approach doesn't seem to work for future_map. Is there some other secret to making this work?
I've created a very simple reprex, obviously my real functions make a lot more sense to run in future_pmap
library(purrr)
library(furrr)
#> Loading required package: future
plan(multiprocess)
xd <- list(1, 10, 100)
yd <- list(1, 2, 3)
zd <- list(5, 50, 500)
sumfun <- function(indata, otherdata){
out <- sum(c(indata, otherdata))
return(out)
}
test_fun_pmap_tilde <- function(ind, ...){
return( pmap(ind, ~sumfun(c(..1,..2,..3), ...)))
}
test_fun_pmap <- function(ind, ...){
return( pmap(ind, function(x,y,z) sumfun(c(x,y,z), ...)))
}
test_fun_future_pmap <- function(ind, ...){
return( future_pmap(ind, function(x,y,z) sumfun(c(x,y,z), ...)))
}
#doesn't work as need to use function(x,y,z) instead of tildes
test_fun_pmap_tilde(list(xd, yd, zd), otherdata = c(100,1000))
#> Error in sumfun(c(..1, ..2, ..3), ...): unused arguments (.l[[2]][[i]], .l[[3]][[i]])
#this one works
test_fun_pmap(list(xd, yd, zd), otherdata = c(100,1000))
#> [[1]]
#> [1] 1107
#>
#> [[2]]
#> [1] 1162
#>
#> [[3]]
#> [1] 1703
#but using future_pmap it doesn't work
test_fun_future_pmap(list(xd, yd, zd), otherdata = c(100,1000))
#> Error in (function (x, y, z) : unused argument (otherdata = c(100, 1000))
Created on 2020-08-31 by the reprex package (v0.3.0)
Okay I have found a way for it to work. Apparently I need 3 sets of ellipsis instead of just 1.
test_fun_future_pmap <- function(ind, ...){
return( future_pmap(ind, function(x,y,z,...) sumfun(c(x,y,z), ...),...))
}
Related
This isn't really a httr2 specific problem though it is easy to illustrate this way. If I have a param that is being to a function that I want to lapply on and that function and the componets of ... need to named, how do I.... do that? I want the function to take the argument name (i.e. param below) use that are the dots name with the values of the vector being lapply over.
library(httr2)
req <- request("http://example.com")
param <- c("foo", "bar")
## hard code param (this is what i am hoping to generate)
lapply(param, \(x) req_url_query(req, param = x))
#> [[1]]
#> <httr2_request>
#> GET http://example.com?param=foo
#> Body: empty
#>
#> [[2]]
#> <httr2_request>
#> GET http://example.com?param=bar
#> Body: empty
## want the ... to dynamically named
my_func <- function(req, ...) {
lapply(..., \(x) req_url_query(req, ...))
}
other_param <- c("x", "y")
my_func(req, other_param)
#> Error in `modify_list()`:
#> ! All components of ... must be named
This looks like it works (edited from comment below):
my_func <- function(req, ...) {
dots <- list(...)
dots_chr <- unlist(dots)
function_string <- paste0("lapply(dots_chr, \\(x) req_url_query(req, ", names(dots), "= x))")
eval(parse(text = function_string))
}
which returns:
$pizza1
<httr2_request>
GET http://example.com?pizza=is_great
Body: empty
$pizza2
<httr2_request>
GET http://example.com?pizza=is_healthy
Body: empty
Here's a version that uses the base do.call function to build the call to the function with the parameter name you want
my_func <- function(req, ...) {
mc <- as.list(match.call()[-(1:2)])
stopifnot(length(mc)==1)
pname <- deparse1(mc[[1]])
if(!is.null(names(mc))) {
pname[names(mc)!=""] <- names(mc)[[names(mc)!=""]]
}
lapply(list(...)[[1]], \(x) do.call("req_url_query", setNames(list(quote(req), x), c("", pname))))
}
It handles all cases like
other_param <- c("x", "y")
my_func(req, other_param)
my_func(req, other_param=1:2)
my_func(req, other_param=other_param)
I have a function that has been saved as an Rds object and I'm wondering if there is any possibility after reading the function to debug() it or to see the code inside the function?
Example
library(purrr)
some_function <- function(x){
avg <- mean(x)
std <- sd(x)
return(c(avg, std))
}
safe_function <- safely(some_function)
saveRDS(safe_function, 'safe_function.rds')
rm(safe_function)
# How can I debug the function or make changes to it after I've loaded it?
safe_function <- readRDS('safe_function.rds')
Here's one way to do it:
Execute debug(safe_function) in the console and then call your function, say, safe_function(c(1, 2))
At this time, you will be in debug mode:
In your console, execute debugonce(.f) and then hit either 'next' or 'continue' (alternatively, type n or c in the console)
You will now be within the body of your some_function and will be able to see the code:
The short answer is that it's easy to extract the underlying function, with a single line of code:
extracted_function <- environment(safe_function)$.f
extracted_function
#> function(x){
#>
#>
#> avg <- mean(x)
#> std <- sd(x)
#>
#> return(c(avg, std))
#>
#> }
#> <bytecode: 0x1951c3e0>
You can debug this function however you like, then if you want to overwrite it but keep it within its safely wrapper, you can overwrite it like this:
debugged_function <- function(x) c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE))
environment(safe_function)$.f <- debugged_function
safe_function(1:10)
#> $result
#> [1] 5.50000 3.02765
#>
#> $error
#> NULL
I'll give a quick explanation of why this works:
If you examine your safe_function, you will notice a couple of unusual things about it. Although you have loaded it into the global environment, it is actually wrapped in its own unnamed environment (in this case <environment: 0x095704c0>), which is integral to the way that it works:
safe_function
#> function (...)
#> capture_error(.f(...), otherwise, quiet)
#> <bytecode: 0x0956fd50>
#> <environment: 0x095704c0>
The other odd thing you'll notice is that safe_function calls the function .f, which is neither a built-in function, nor a function exported from purrr. That's because .f is a copy of your original function that is kept inside this special environment.
We can look at the complete contents of the unnamed environment by doing:
ls(environment(safe_function), all.names = TRUE)
#> [1] ".f" "otherwise" "quiet"
Now, if you look at what .f is, you will find it is just a copy of your original some_function:
#> function(x){
#>
#>
#> avg <- mean(x)
#> std <- sd(x)
#>
#> return(c(avg, std))
#>
#> }
#> <bytecode: 0x1951c3e0>
So this is where your wrapped function is "hiding". It remains accessible as a member of this unnamed environment, which can be accessed via environment(safe_function) so is easy to modify if desired.
We can use purrr::partial to create partial functions:
f <- function(x, y) {
print(x)
print(y)
return(invisible())
}
ff <- purrr::partial(f, y = 1)
ff(2)
#> [1] 2
#> [1] 1
Created on 2020-02-19 by the reprex package (v0.3.0)
This can often be quite useful, but has the unfortunate side-effect that the partialized function loses it's signature, which is replaced with an elipsis:
ff
#> <partialised>
#> function (...)
#> f(y = 1, ...)
While programatically irrelevant, this leads to worse code legibility during development, where RStudio's "intellisense" can no longer aid us in remembering the names and/or order of arguments. So is there some other means of partializing which keeps the original signature (minus the partialized-away arguments), as below?
ff
#> <partialised>
#> function (x)
#> f(y = 1, x)
Now, obviously this can be done manually, by defining a new function ff which is simply a wrapper around f with the desired arguments.
ff <- function(x) f(x, y = 1)
But this means any modifications to the signature of f need to be replicated to ff. So is there a "cleaner" way of partializing while keeping the signature?
One option is to use rlang::fn_fmls() (or base::formals() equivalent) to explicitly give default values to the function arguments:
# If desired, create a copy of the function first: ff <- f
rlang::fn_fmls(f) <- purrr::list_modify( rlang::fn_fmls(f), y=1 )
args(f)
# function (x, y = 1)
f(2)
# [1] 2
# [1] 1
I want to avoid using parse() in a function definition that contains a polynomial().
My polynomial is this:
library(polynom)
polynomial(c(1, 2))
# 1 + 2*x
I want to create a function which uses this polynomial expression as in:
my.function <- function(x) magic(polynomial(c(1, 2)))
where for magic(), I have tried various combinations of expression(), formula(), eval(), as.character(), etc... but nothing seems to work.
My only working solution is using eval(parse()):
eval(parse(text = paste0('poly_function <- function(x) ', polynomial(c(1, 2)))))
poly_function(x = 10)
# 21
Is there a better way to do want I want? Can I avoid the eval(parse())?
Like you, I though that the polynomial function was returning an R expression, but we were both wrong. Reading the help Index for package:polynom would have helped us both:
str(pol)
#Class 'polynomial' num [1:2] 1 2
help(pac=polynom)
So user20650 is correct and:
> poly_function <- as.function(pol)
> poly_function(10)
[1] 21
So this was how the authors (Venables, Hornick, Maechler) do it:
> getAnywhere(as.function.polynomial)
A single object matching ‘as.function.polynomial’ was found
It was found in the following places
registered S3 method for as.function from namespace polynom
namespace:polynom
with value
function (x, ...)
{
a <- rev(coef(x))
w <- as.name("w")
v <- as.name("x")
ex <- call("{", call("<-", w, 0))
for (i in seq_along(a)) {
ex[[i + 2]] <- call("<-", w, call("+", a[1], call("*",
v, w)))
a <- a[-1]
}
ex[[length(ex) + 1]] <- w
f <- function(x) NULL
body(f) <- ex
f
}
<environment: namespace:polynom>
Since you mention in your comments that getAnywhere was new then it also might be the case that you could gain by reviewing the "run up" to using it. If you type a function name at the console prompt, you get the code, in this case:
> as.function
function (x, ...)
UseMethod("as.function")
<bytecode: 0x7f978bff5fc8>
<environment: namespace:base>
Which is rather unhelpful until you follow it up with:
> methods(as.function)
[1] as.function.default as.function.polynomial*
see '?methods' for accessing help and source code
The asterisk at the end of the polynomial version tells you that the code is not "exported", i.e. available at the console just by typing. So you need to pry it out of a loaded namespace with getAnywhere.
It seems like you could easily write your own function too
poly_function = function(x, p){
sum(sapply(1:length(p), function(i) p[i]*x^(i-1)))
}
# As 42- mentioned in comment to this answer,
# it appears that p can be either a vector or a polynomial
pol = polynomial(c(1, 2))
poly_function(x = 10, p = pol)
#[1] 21
#OR
poly_function(x = 10, p = c(1,2))
#[1] 21
I am working on a project to profile function outputs so need to pass a function in as an argument in R. To clarify, I have a varying number of models, and am not looking for assistance on setting up the models, just passing in the model function names into the scoring function.
This works for a direct call, but I want to make it more generic for building out the module. Here is a brief example:
#create a test function:
model1 = function(y,X){
fit = lm(y~X)
output = data.frame(resid = fit$residuals)
}
#score function:
score = function(y,X,model){
y= as.matrix(y)
X = as.matrix(X)
fitModel = model(y,X)
yhat = y - fitModel$residual
output = data.frame(yhat=yhat)
}
I can call this code with valid y and X mats with
df <- data.frame(x=rnorm(5),y=runif(5))
scoreModel1 = score(df$y,df$x,model1)
But what I am looking for is a method of listing all of the models, and looping through, and/or calling the score function in a generic way. For instance:
models = c("model1")
scoreModel1 = score(df$y,df$x,models[1])
The error that I get with the above code is
Error in score(y, X, model) :
could not find function "model"
I have played around with as.function(), and listing and unlisting the args, but nothing works. For instance all the following args have rendered the same error as above
models = c(model1)
models = list(model1)
models = list("model1")
Thank you in advance for your help.
For anyone arriving here from google wondering how to pass a function as an argument, here's a great example:
randomise <- function(f) f(runif(1e3))
randomise(mean)
#> [1] 0.5029048
randomise(sum)
#> [1] 504.245
It's from Hadley's book found here
your list objects can simply be the functions directly. Maybe you can get some use out of this structure, or else take Roland's advice and pass formulas. Richiemorrisroe's answer is probably cleaner.
fun1 <- function(x,y){
x+y
}
fun2 <- function(x,y){
x^y
}
fun3 <- function(x,y){
x*y
}
models <- list(fun1 = fun1, fun2 = fun2, fun3 = fun3)
models[["fun1"]](1,2)
[1] 3
models[[1]](1,2)
[1] 3
lapply(models, function(FUN, x, y){ FUN(x = 1, y = 2)})
$fun1
[1] 3
$fun2
[1] 1
$fun3
[1] 2
match.fun is your friend. It is what apply tapply et al use for the same purpose. Note that if you need to pass arguments to the model fitting functions then you will either need to bundle all of these up into a function like so function(x) sum(x==0, na.rm=TRUE) or else supply them as a list and use do.call like so do.call(myfunc, funcargs).
Hope this helps.
another response:
models = list(model1)
scoreModel1 = score(df$y,df$x,models[[1]])
Example to pass function in as variable:
f_add<- function(x,y){ x + y }
f_subtract<- function(x,y){ x - y }
f_multi<- function(x,y){ x * y }
operation<- function(FUN, x, y){ FUN(x , y)}
operation(f_add, 9,2)
#> [1] 11
operation(f_subtract, 17,5)
#> [1] 12
operation(f_multi,6,8)
#> [1] 48
good luck