Dynamically named dots passed to lapply - r

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)

Related

setMethod distinguish between using to "assign" to variable and pure "info" call

Anyone know if the following can be achieved in R specifically S4
foo <- setClass("foo", contains = "matrix")
foo <- function(m = matrix(1:9, nrow = 3)) new("foo", m)
setMethod("dim", signature = "foo",
function(x) {
dd <- dim(x#.Data)
cat("foo dims: ")
return(dd)
}
)
# followed by
bar <- foo()
How or can it be achieved to distinguish between ...
dim(bar)
# which gives
foo dims: [1] 3 3
# and calling dim to assign the return value to a variable
# ie this call
bardims <- dim(bar)
# which does
foo dims:
# but I don't want it to produce any cat output to the console/screen
in the second case I would like to suppress the cat(....) part of the original "dim,foo-method".
I would not mind defining something like setMethod('<-dim', 'foo', function(.... but I guess that is not available?
Info: I am using R-4.0.5 here
It's generally not a great idea to use cat() to spit out messages in function. It gives users very little control over how they display and makes it very difficult to grab those values should they ever want them.
A possible alternative is to annotate the response with a custom class that will output a message only when print()-ed. Hence it will not show up during assignment because those results are returned invisibly.
Here's an S3 class that can help
annotate_value <- function(val, msg) {
attr(val, "message") <- msg
class(val) <- c("annotated", class(val))
val
}
print.annotated <- function(x) {
class(x) <- setdiff(class(x), "annotated")
cat(attr(x, "message"))
attr(x, "message") <- NULL
print(x)
}
And then you use it like
setMethod("dim", signature = "foo",
function(x) {
dd <- dim(x#.Data)
annotate_value(dd, "foo dims:")
}
)
Then when you run your code, you get the desired output
bar <- foo()
dim(bar)
# foo dims:[1] 3 3
bardims <- dim(bar)
#

Modify the return/print option of a custom function in r

I built a custom function in which it prints an output of the class and it's probability (classifier), like the following:
fun(formula, data)
> "Class" 0.5
I integrate this fun into another function new_fun, but I use a modified result of fun as an output for new_fun. Therefore, I don't need to original output of fun of the class and probability. Is there a way to avoid returning/printing the original output once it's integrated into new_fun?
You could use capture.output:
f <- function() {print("test"); "result"}
g <- function() { capture.output(result<-f()); result}
f()
#> [1] "test"
#> [1] "result"
g()
#> [1] "result"
Created on 2020-09-30 by the reprex package (v0.3.0)
In the example you provided, this would be:
new_fun <- function(...){
myformula <- ...
mydata <- ...
#Call to fun with captured output
capture.output( funresult <- fun(myformula, mydata))
#Process further funresult
...
}

How to pass a string as a parameter to a function which expects a variable in R

The first call to the function f works, the second does not. How can I pass a String ("v") to the function f so that the function works as exspected?
library(data.table)
f<-function(t,x) t[,deparse(substitute(x)),with=F]
dat<-data.table(v="a")
f(dat,v)
# v
# 1: a
f(dat,eval(parse(text="v")))
# Error in `[.data.table`(t, , deparse(substitute(x)), with = F) :
# column(s) not found: eval(parse(text = "v"))
It won't be a one-liner anymore but you can test for what you're passing in:
library(data.table)
library(purrr)
dat <- data.table(v="a")
f <- function(dt, x) {
# first, see if 'x' is a variable holding a string with a column name
seval <- safely(eval)
res <- seval(x, dt, parent.frame())
# if it is, then get the value, otherwise substitute() it
if ((!is.null(res$result)) && inherits(res$result, "character")) {
y <- res$result
} else {
y <- substitute(x)
}
# if it's a bare name, then we deparse it, otherwise we turn
# the string into name and then deparse it
if (inherits(y, "name")) {
y <- deparse(y)
} else if (inherits(y, "character")) {
y <- deparse(as.name(x))
}
dt[, y, with=FALSE]
}
f(dat,v)
## v
## 1: a
f(dat, "v")
## v
## 1: a
V <- "v"
f(dat, V)
## v
## 1: a
f(dat, VVV)
#> throws an Error
I switched it from t to dt since I don't like using the names of built-in functions (like t()) as variable names unless I really have to. It can introduce subtle errors in larger code blocks that can be frustrating to debug.
I'd also move the safely() call outside the f() function to save a function call each time you run f(). You can use old-school try() instead, if you like, but you have to check for try-error which may break some day. You could also tryCatch() wrap it, but the safely() way just seems cleaner to me.

R functions, access to parameter names

I have the following code:
fn <- 'George'
mn <- 'Walker'
ln <- 'Bush'
f <- function(...) { print(list(...)) }
When I call it, it produces the following output:
f(fn,mn,ln)
[[1]]
[1] "George"
[[2]]
[1] "Walker"
[[3]]
[1] "Bush"
Suppose I wanted something similar to this (note the parameter names):
fn:George
mn:Walker
ln:Bush
Question: I know how to get the VALUES of the arguments inside a function. How do I get the NAMES of the arguments inside the function?
Thanks, CC.
You may use
f <- function(...) {
nm1 <- as.list(match.call()[-1])
val <- list(...)
cat(paste(nm1, val, sep=":", collapse="\n"),'\n') }
f(fn,mn,ln)
#fn:George
#mn:Walker
#ln:Bush

Get name of function from loop variable

I need to loop through a number of functions, and plot/print the result next to the function name. I learned (this question/answer) that I have to use substitute / eval. This works nicely if each function name per se is enclosed in substitute() (see (A) and (B) below). Is there a way to automatize this, e.g. by using a construction similar to sapply? (C) obviously fails because substitute encloses also the c() clause, but maybe there is a something that I missed to make (D) work? Or any other ideas? Or is there no way?
This is what I tried (small examples, real code has many more functions and plotting stuff).
# A
x <- c(1:10)
my.fun <- substitute(mean) # works
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
# B
for (my.fun in c(substitute(mean), substitute(median))) { # works, but lots of typing for longer function lists
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# C
for (my.fun in substitute(c(mean, median))) { # error: invalid for() loop sequence
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# D
for (my.fun in sapply(c(mean, median), substitute)) { # error: '...' used in an incorrect context
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# E # also not helpful
my.functions <- c(mean, median)
my.fun.2 <- NULL
for (i in 1:2) {
my.fun.2 <- c(my.fun.2, substitute(my.functions[i]))
}
# my.fun.2
# [[1]]
# my.functions[i]
# [[2]]
# my.functions[i]
What about this "one-liner"? :)
> x <- c(1:10)
> f <- function(...)
+ sapply(
+ sapply(
+ as.list(substitute(list(...)))[-1L],
+ deparse),
+ function(fn)
+ get(fn)(x))
> f(mean, median)
mean median
5.5 5.5
In short, you can pass the functions as multiple arguments, then quickly deparse those before actually evaluating the functions one by one. So the above function with a few extra comments:
#' Evaluate multiple functions on some values
#' #param ... any number of function that will take \code{x} as the argument
#' #param x values to be passed to the functions
#' #examples
#' f(mean, median)
#' f(mean, median, sum, x = mtcars$hp)
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function as an anonymous function on "x"
sapply(fns, function(fn) get(fn)(x))
}
Or with do.call instead of this latter anonymous function:
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function on "x"
sapply(fns, do.call, args = list(x))
}

Resources