[R] Fine controlling "three dots" argument dispatch to functions with identical argument names
Janko Thyson
janko.thyson at gmail.com
Mon Nov 17 01:25:34 CET 2014
@Duncan, @Jeff: thanks for giving me your opinions, I really appreciate
that! I'm not saying that this is something that should *generally* be used
and I perfectly understand your concerns. However: correct me if I'm wrong,
but actually I'm not doing much more than generalizing the idea behind
`...` from the case where only *one *more function is called further down
the calling stack to the the general case where *n* more functions get
called.
*@Duncan*: consider the `plot()` function: following your argumentation,
you would also want to see all of the paramters controlled via `par()` as
explicit paramters of `plot()` - if I understand you correctly. Of course
I'm exagerating to get my point accross and I do see your point. I think
the guys behind `roygen` have put it quite perfectly (
http://cran.r-project.org/web/packages/roxygen2/vignettes/rd.html):
*Do repeat yourself*
*There is a tension between the DRY (do not repeat yourself) principle of
programming and the need for documentation to be self-contained. It's
frustrating to have to navigate through multiple help files in order to
pull together all the pieces you need. *
But I think it's a *trade-off* that needs to be decided on on a
*case-by-case* basis. For example, IMO for `plot()` and other functions
using `par()` it makes perfect sense to use `...` quite extensively: while
users might very well argue that they would prefer to see all the args
`plot()` can take in its help file I'm sure that developers/maintainers of
all the functions depending on `par()` would see that from quite a
different perspective. It would take quite some effort to propagate changes
in `par()` to all dependent functions.
As foryour question about how to document it: I don't see why that should
be a problem (see roxygen code below for `foobar()`). You can link to the
help pages of functions across packages just as is the case in for `plot()`
with respect to `par()`. The same documentation structure could also be
used for `foo()` and `bar()`.
*@Jeff*: well, if the mechanism is well documented, I don't see what you
are really loosing by wrapping things to a list first instead of passing
them directly as `...`: the only crucial part is that in a call to a
specific function, a dispatching mechanism would need to make sure that the
correct list is selected - or to be more precise that everything that came
via `...` is split up in a part that's used as explicit arguments for the
actual function call and a part that is passed along as the new/updated
`...` to subsequent functions.
>From there on, from the perspective of the function being called, it's just
as if `y` had been passed as such from the beginning (instead of via list
construct `args_<func>$y`).
As for the concern that functions would be tied to a certain
implementation: sure, that's true - but if you wrap everything in something
like `withThreedots()`, it's actually not much different (structure-wise)
from a call to `sapply()` and the like. What would really be neat is if one
could definde S4 methods for `...` and have the built-in dispatcher do the
job that `withThreedots()` currently does. Instead of a list
`args_<function>` one would use class instances along the line of
`Threedots$new(<args-list>, <function-name>)`.
Best regards and thanks for your opinions again!
Here's the `withThreedots()` implementation
*Definitions //*
withThreedots <- function(fun, ...) {
threedots <- list(...)
idx <- which(names(threedots) %in% sprintf("args_%s", fun))
eval(substitute(
do.call(FUN, c(THREE_THIS, THREE_REST)),
list(
FUN = as.name(fun),
THREE_THIS = if (length(idx)) threedots[[idx]],
THREE_REST = if (length(idx)) threedots[-idx] else threedots
)
))
}
#' @title
#' Does something foobar
#'
#' @description
#' Calls \code{\link[foo.package]{foo}}.
#'
#' @section Argument dispatch via ...:
#'
#' Calling subsequent functions is handled by function
#' \code{\link{withThreedots}}. In order for it to dispatch the correct
#' arguments to the various functions further down the calling stack,
#' you need to wrap them in a individual lists and name them according to
#' the following convention: \code{args_<function-name>}.
#'
#' For example, arguments that should be passed to
#' \code{\link[foo.package]{foo} would need to be stated as follows:
#' \code{args_foo = list(y = "hello world!")}. The same goes for arguments
#' that \code{\link[foo.package]{foo} passes to its subsequent functions.
#'
#' @param x \code{\link{character}}. Some argument.
#' @param ... Further arguments to be passed to subsequent functions.
#' In particular:
#' \itemize{
#' \item{\code{\link[foo.package]{foo}}. Make sure to also check if
#' this function in turn can pass along arguments via \code{...}.
#' In this case, you can also include those arguments.}
#' }
#' See section \strong{Argument dispatch via ...} for details about the
#' expected object structure of things to pass via \code{...}.
#' @example inst/examples/existsNested.r
#' @seealso \code{\link[foo.package]{foo}}
#' @export
foobar <- function(x, ...) {
withThreedots("foo", x = x, ...)
}
foo <- function(x = x, y = "some text", ...) {
message("foo/y")
print(y)
withThreedots("bar", x = x, ...)
}
bar <- function(x = x, y = 1, ...) {
message("bar/y")
print(y)
withThreedots("downTheLine", x = x, ...)
}
downTheLine <- function(x = x, y = list(), ...) {
message("downTheLine/y")
print(y)
}
*Apply //*
foobar(x = 10)
foobar(x = 10, args_foo = list(y = "hello world!"))
foobar(x = 10, args_bar = list(y = 10))
foobar(x = 10, args_downTheLine = list(y = list(a = TRUE)))
foobar(x = 10,
args_foo = list(y = "hello world!"),
args_bar = list(y = 10),
args_downTheLine = list(y = list(a = TRUE))
)
On Sun, Nov 16, 2014 at 7:54 PM, Jeff Newmiller <jdnewmil at dcn.davis.ca.us>
wrote:
> You have some interesting ideas about what makes for improvements in
> parameter interfaces. Wrapping the arguments into a list is like creating
> an object to represent all of them, except that you don't have the benefits
> of a class to go with that cognitive shift. And if making classes to hold
> parameters were appropriate wouldn't you have already done so in the foo
> and bar interfaces? That is a heavyweight approach that doesn't always make
> sense.
>
> I agree with Duncan that each time you define a function you are defining
> an interface that should stand on its own... the user should be able to
> associate unique names with unique behaviors. From this perspective, your
> reluctance to define a unified set of uniquely-named parameters for each of
> foobar and (and apparently foo) seems illogical.
> ---------------------------------------------------------------------------
> Jeff Newmiller The ..... ..... Go Live...
> DCN:<jdnewmil at dcn.davis.ca.us> Basics: ##.#. ##.#. Live
> Go...
> Live: OO#.. Dead: OO#.. Playing
> Research Engineer (Solar/Batteries O.O#. #.O#. with
> /Software/Embedded Controllers) .OO#. .OO#. rocks...1k
> ---------------------------------------------------------------------------
> Sent from my phone. Please excuse my brevity.
>
> On November 16, 2014 8:42:20 AM PST, Janko Thyson <janko.thyson at gmail.com>
> wrote:
> >Thanks for the info/suggestions!
> >
> >But note that it's not just a one-step, but a two step dispatching
> >process
> >with respect to `...`. That is, `foo()` and `bar()` are *not* both
> >called
> >directly inside `foobar()`: `foobar()` only calls `foo()` which then
> >calls
> >`bar()`.
> >
> >I now came up with something along the lines of what Duncan suggested.
> >The
> >reason I wouldn't want to go with Jeff's approach is that I would want
> >`foobar()` to remain as generic an interface as possible (the same goes
> >for
> >`foo()` calling `bar()`).
> >
> >I.e., I don't want it to have any explicit arguments of subsequently
> >called
> >functions (e.g. `y_foo`). It should just be able to take any inputs
> >that
> >subsequently called functions can process (i.e. `foo()` and then in
> >turn
> >`bar()`) and pass them along accordingly. Of course this would need to
> >be
> >clearly and well documented for the respective functions.
> >
> >So here's my current approach. It would be nice to just be able to
> >dispatch
> >`...` for calls of `do.call()` like so: `do.call("foo", c(x = x, ...))`
> >but
> >that way a nested structure of `...` gets flattened out (see respective
> >lines in `foobar()`). That's why I need to resort to `do.call("foo",
> >c(x =
> >x, threedots$args_foo, threedots[-idx]))`. What do you think of it?
> >
> >foobar <- function(x, ...) {
> > message("foobar ----------")
> > message("foobar/threedots")
> > threedots <- list(...)
> > try(print(threedots))
> > message("foobar/combined args")
> > try(print(c(x, threedots)))
> >## --> list gets flattened (i.e. `args_foo.y` instead of nested
> >structure)
> > ## --> that's why subsequent functions will not recognize "their"
> >arguments
> > ## from it
> > if (any(idx <- names(threedots) %in% "args_foo")) {
> > do.call("foo", c(x = x, threedots$args_foo, threedots[-idx]))
> > } else {
> > foo(x = x, ...)
> > }
> >}
> >foo <- function(x, y = "some character", ...) {
> > message("foo ----------")
> > message("foo/threedots")
> > threedots <- list(...)
> > try(print(threedots))
> > message("foo/y")
> > try(print(y))
> > if (any(idx <- names(threedots) %in% "args_bar")) {
> > do.call("bar", c(x = x, threedots$args_bar, threedots[-idx]))
> > } else {
> > bar(x = x, ...)
> > }
> >}
> >bar <- function(x, y = TRUE, ...) {
> > message("bar ----------")
> > message("bar/threedots")
> > try(print(list(...)))
> > message("bar/y")
> > try(print(y))
> > return(paste0("hello: ", x))
> >}
> >
> >foobar(x = "John Doe", args_foo = list(y = "hello world!"))
> >foobar(x = "John Doe", args_bar = list(y = FALSE))
> >foobar(x = "John Doe",
> > args_foo = list(y = "hello world!"),
> > args_bar = list(y = FALSE)
> >)
> >
> >Best regards and thanks,
> >Janko
> >
> >On Sat, Nov 15, 2014 at 6:10 PM, Duncan Murdoch
> ><murdoch.duncan at gmail.com>
> >wrote:
> >
> >> On 15/11/2014, 11:26 AM, Jeff Newmiller wrote:
> >> > AFAIK You have to alter the name of at least one of the y arguments
> >as
> >> used by foobar, and anyone calling foobar has to read about that in
> >the
> >> help file. That is only one y can be in "...". e.g.
> >> >
> >> > foobar <- function( x, y_foo, ... ) {
> >> > foo( x, y=y_foo, ... )
> >> > bar( x, ... )
> >> > }
> >> >
> >>
> >> That's the best solution. There is another one: you can put
> >>
> >> args <- list(...)
> >>
> >> into foobar(), and then do whatever you like to the args vector, and
> >put
> >> together calls to foo() and bar() using do.call(). But this is hard
> >to
> >> read and easy to get wrong, so I recommend Jeff's simple solution.
> >>
> >> Duncan Murdoch
> >>
> >> >
> >> >
> >>
>
> >---------------------------------------------------------------------------
> >> > Jeff Newmiller The ..... ..... Go
> >> Live...
> >> > DCN:<jdnewmil at dcn.davis.ca.us> Basics: ##.#. ##.#.
> >Live
> >> Go...
> >> > Live: OO#.. Dead: OO#..
> >Playing
> >> > Research Engineer (Solar/Batteries O.O#. #.O#.
> >with
> >> > /Software/Embedded Controllers) .OO#. .OO#.
> >> rocks...1k
> >> >
> >>
>
> >---------------------------------------------------------------------------
> >> > Sent from my phone. Please excuse my brevity.
> >> >
> >> > On November 15, 2014 6:49:41 AM PST, Janko Thyson <
> >> janko.thyson at gmail.com> wrote:
> >> >> Dear list,
> >> >>
> >> >> I wonder if there's a clever way to fine control the exact way
> >> >> arguments
> >> >> are dispatched via R's "three dots" argument ....
> >> >>
> >> >> Consider the following use case:
> >> >>
> >> >> - you have a function foobar() that calls foo() which in turn
> >calls
> >> >> bar()
> >> >> - *both* foo() and bar() have an argument that's called y, but
> >they
> >> >> each
> >> >> have a *different meaning*
> >> >> - in the call to foobar(), you would like to say "here's the y for
> >> >> foo()
> >> >> and here's the y for bar()". *That's what I would like to
> >accomplish*.
> >> >>
> >> >> If you simply call foobar(x = "John Doe", y = "hello world"), y
> >only
> >> >> get's
> >> >> dispatched to foo() as in the call to bar() things would have to
> >be
> >> >> explicit in order to be dispatched (i.e. the call would have to be
> >> >> bar(x =
> >> >> x, y = y) instead of bar(x = x, ...):
> >> >>
> >> >> foo <- function(x, y = "some character", ...) {
> >> >> message("foo ----------")
> >> >> message("foo/threedots")
> >> >> try(print(list(...)))
> >> >> message("foo/y")
> >> >> try(print(y))
> >> >> bar(x = x, ...)}
> >> >> bar <- function(x, y = TRUE, ...) {
> >> >> message("bar ----------")
> >> >> message("bar/threedots")
> >> >> try(print(list(...)))
> >> >> message("bar/y")
> >> >> try(print(y))
> >> >> return(paste0("hello: ", x))}
> >> >> foobar <- function(x, ...) {
> >> >> message("foobar ----------")
> >> >> message("foobar/threedots")
> >> >> try(print(list(...)))
> >> >> foo(x = x, ...)}
> >> >>
> >> >> foobar(x = "John Doe", y = "hi there")# foobar ----------#
> >> >> foobar/threedots# $y# [1] "hi there"# # foo ----------#
> >foo/threedots#
> >> >> list()# foo/y# [1] "hi there"# bar ----------# bar/threedots#
> >list()#
> >> >> bar/y# [1] TRUE# [1] "hello: John Doe"
> >> >>
> >> >> What I conceptionally would like to be able to do is something
> >like
> >> >> this:
> >> >>
> >> >> foobar(x = "John Doe", y_foo = "hello world!", y_bar = FALSE)
> >> >>
> >> >> Here's an approach that works but that also feels very odd:
> >> >>
> >> >> foo <- function(x, y = "some character", ...) {
> >> >> message("foo ----------")
> >> >> message("foo/threedots")
> >> >> try(print(list(...)))
> >> >> message("foo/y")
> >> >> arg <- paste0("y_", sys.call()[[1]])
> >> >> if (arg %in% names(list(...))) {
> >> >> y <- list(...)[[arg]]
> >> >> }
> >> >> try(print(y))
> >> >> bar(x = x, ...)}
> >> >> bar <- function(x, y = TRUE, ...) {
> >> >> message("bar ----------")
> >> >> message("bar/threedots")
> >> >> try(print(list(...)))
> >> >> message("bar/y")
> >> >> arg <- paste0("y_", sys.call()[[1]])
> >> >> if (arg %in% names(list(...))) {
> >> >> y <- list(...)[[arg]]
> >> >> }
> >> >> try(print(y))
> >> >> return(paste0("hello: ", x))}
> >> >>
> >> >> foobar(x = "John Doe", y_foo = "hello world!", y_bar = FALSE)#
> >foobar
> >> >> ----------# foobar/threedots# $y_foo# [1] "hello world!"# #
> >$y_bar#
> >> >> [1] FALSE# # foo ----------# foo/threedots# $y_foo# [1] "hello
> >> >> world!"# # $y_bar# [1] FALSE# # foo/y# [1] "hello world!"# bar
> >> >> ----------# bar/threedots# $y_foo# [1] "hello world!"# # $y_bar#
> >[1]
> >> >> FALSE# # bar/y# [1] FALSE# [1] "hello: John Doe"
> >> >>
> >> >> How would you go about implementing something like this?
> >> >>
> >> >> I also played around with S4 method dispatch to see if I could
> >define
> >> >> methods for a signature argument ..., but that didn't go too well
> >(and
> >> >> it's
> >> >> probably a very bad idea anyway):
> >> >>
> >> >> setGeneric(
> >> >> name = "foo",
> >> >> signature = c("x", "..."),
> >> >> def = function(x, ...) standardGeneric("foo") )
> >> >> setMethod(
> >> >> f = "foo",
> >> >> signature = signature(x = "character", "..." =
> >"MyThreeDotsForBar"),
> >> >> definition = function(x, ...) bar(x = x))## --> does not work
> >> >>
> >> >> [[alternative HTML version deleted]]
> >> >>
> >> >> ______________________________________________
> >> >> R-help at r-project.org mailing list
> >> >> https://stat.ethz.ch/mailman/listinfo/r-help
> >> >> PLEASE do read the posting guide
> >> >> http://www.R-project.org/posting-guide.html
> >> >> and provide commented, minimal, self-contained, reproducible code.
> >> >
> >> > ______________________________________________
> >> > R-help at r-project.org mailing list
> >> > https://stat.ethz.ch/mailman/listinfo/r-help
> >> > PLEASE do read the posting guide
> >> http://www.R-project.org/posting-guide.html
> >> > and provide commented, minimal, self-contained, reproducible code.
> >> >
> >>
> >>
>
>
[[alternative HTML version deleted]]
More information about the R-help
mailing list