CODEWITHSUNDEEP
rparameter-passingellipsisrlang
Rappster
Rappster

Reputation: 13090

Updating values of three dot ellipsis in R

I have a function foo() that I'd like to be able to call in two different "modes": once or within a while loop.

I thought using a somewhat generic wrapper (runtime_gateway()) and passing arguments via ... to foo() would make sense here so I could leverage the same "runtime gateway logic" for arbitrary functions with different sets of arguments.

If run foo() within a while loop, I'd like to update some of its arguments while keeping the default or passed values of other arguments.

How would I do that?

I'm aware of rlang::dot_list(...) and friends and had a quick glance at https://github.com/r-lib/ellipsis. It seems that any of those would only let pluck values from or inspect ellipsis content, but I don't see how I could "update it in transit".

Reprex

foo <- function(
  id = "id_a",
  at = Sys.time()
) {
  message(stringr::str_glue("{id}: {at}"))
  Sys.sleep(1)
}

runtime_gateway <- function(
  fun = foo,
  run_mode = c("once", "while"),
  ... # Args to be passed to `fun`
) {
  run_mode <- match.arg(run_mode)

  if (run_mode == "once") {
    fun(...)
  } else if (run_mode == "while") {
    counter <- 0

    while(counter < 3) {
      # Goal: keep ellipsis value for `id` but *update* value for `at`
      dots <- rlang::dots_list(...)
      at <- if ("at" %in% names(dots)) {
        message("`at` was passed via ellipsis:")
        message(dots$at)
        dots$at
      } else {
        Sys.time()
      }

      fun(at = at + 60, ...)
      counter <- counter + 1
    }
  }
}

runtime_gateway()
#> id_a: 2020-02-21 14:09:16.779
runtime_gateway(at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> id_a: 2020-02-21 10:30:00

runtime_gateway(run_mode = "while")
#> id_a: 2020-02-21 14:10:18.897
#> id_a: 2020-02-21 14:10:19.900
#> id_a: 2020-02-21 14:10:20.902
runtime_gateway(run_mode = "while", id = "id_b")
#> id_b: 2020-02-21 14:10:21.905
#> id_b: 2020-02-21 14:10:22.906
#> id_b: 2020-02-21 14:10:23.908
runtime_gateway(run_mode = "while", at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> `at` was passed via ellipsis:
#> 2020-02-21 10:30:00
#> Error in fun(at = at + 60, ...): formal argument "at" matched by multiple actual arguments

Created on 2020-02-21 by the reprex package (v0.3.0)

Upvotes: 3

Views: 515

Answers (2)

Mark Heckmann
Mark Heckmann

Reputation: 11441

Updating ... in transit

As @krlmlr points out in his comment, there seems to be no documented standard way (or packages) to update ... directly. However, it is possible to access ... using get (see here) or env$... and also replace the <...> object (albeit not directly). Hence, we could create a getter (g) and setter (s) function for .... Behind the scenes, a conversion from ... to a list still occurs, but we won't see it as a user and have a simple interface for updating ....

.get_dots <- function(envir) {
  assign("...", envir$...)
  list(...)
}

# getter
g <- function(x) {
  x <- deparse(substitute(x))
  envir <- parent.frame()
  dots <- .get_dots(envir)
  dots[[x]]
}

# setter
s <- function(...) {
  envir <- parent.frame()
  dots <- modifyList(.get_dots(envir), list(...))
  do.call(\(...) { # create new <...> object and replace in caller env
    assign("...", environment()$..., envir = envir)
  }, dots)
}

# toy example
foo <- \(...) {
  cat("-- START --------\n")
  print(list(...))

  cat("-- CHANGE 1: update 'a', add 'b' -------\n")
  s(a = 999, b = 2) # set a and b
  print(list(...))

  cat("-- CHANGE 2: increment 'a', remove 'b' -------\n")
  s(a = g(a) + 1, b = NULL) # set a, using a's current value, remove b
  print(list(...))
}

foo(a = 1)
#> -- START --------
#> $a
#> [1] 1
#> 
#> -- CHANGE 1: update 'a', add 'b' -------
#> $a
#> [1] 999
#> 
#> $b
#> [1] 2
#> 
#> -- CHANGE 2: increment 'a', remove 'b' -------
#> $a
#> [1] 1000

Created on 2024-09-30 with reprex v2.1.1

Apply to your example

Now let's apply this approach to your example (using the getter and setter code from above).

NB: I'm not sure, if I got the updating position right in the code, but it will convey the idea.

foo <- function(
    id = "id_a",
    at = Sys.time()) {
  message(stringr::str_glue("{id}: {at}"))
  Sys.sleep(1)
}


runtime_gateway <- function(
    fun = foo,
    run_mode = c("once", "while"),
    ... # Args to be passed to `fun`
    ) {
  run_mode <- match.arg(run_mode)

  if (run_mode == "once") {
    fun(...)
  } else if (run_mode == "while") {
    counter <- 0
    at_in_initial_dots <- !is.null(g(at))
    while (counter < 3) {
      if (at_in_initial_dots) {
        message("`at` was passed via ellipsis:")
        message(g(at))
        s(at = g(at) + 60) # --> increment `at` by 60
      } else {
        s(at = Sys.time() + 60) # --> set `at`
      }
      fun(...) # --> passing updated ... possible now
      counter <- counter + 1
    }
  }
}


runtime_gateway()
#> id_a: 2024-09-30 14:06:14.921671
runtime_gateway(at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> id_a: 2020-02-21 10:30:00
runtime_gateway(run_mode = "while")
#> id_a: 2024-09-30 14:07:17.315431
#> id_a: 2024-09-30 14:07:18.342516
#> id_a: 2024-09-30 14:07:19.368168
runtime_gateway(run_mode = "while", id = "id_b")
#> id_b: 2024-09-30 14:07:20.395082
#> id_b: 2024-09-30 14:07:21.416899
#> id_b: 2024-09-30 14:07:22.447479
runtime_gateway(run_mode = "while", at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> `at` was passed via ellipsis:
#> 2020-02-21 10:30:00
#> id_a: 2020-02-21 10:31:00
#> `at` was passed via ellipsis:
#> 2020-02-21 10:31:00
#> id_a: 2020-02-21 10:32:00
#> `at` was passed via ellipsis:
#> 2020-02-21 10:32:00
#> id_a: 2020-02-21 10:33:00

Created on 2024-09-30 with reprex v2.1.1

Upvotes: 0

Allan Cameron
Allan Cameron

Reputation: 174378

You could ensure that dots contains an at argument by adding it if it isn't present, then dispatch fun using dots instead of ... with do.call

runtime_gateway <- function(
  fun = foo,
  run_mode = c("once", "while"),
  ... # Args to be passed to `fun`
) {
  run_mode <- match.arg(run_mode)

  if (run_mode == "once") {
    fun(...)
  } else if (run_mode == "while") {
    counter <- 0

    while(counter < 3) {
      # Goal: keep ellipsis value for `id` but *update* value for `at`
      dots <- rlang::dots_list(...)
      if ("at" %in% names(dots)) {
        message("`at` was passed via ellipsis:")
        message(dots$at)
        dots$at <- dots$at + 60
      } else {
        dots$at <- Sys.time() + 60
      }

      do.call(fun, dots)
      counter <- counter + 1
    }
  }
}

And here's the output:

runtime_gateway()
#> id_a: 2020-02-21 14:22:07

runtime_gateway(at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> id_a: 2020-02-21 10:30:00

runtime_gateway(run_mode = "while")
#> id_a: 2020-02-21 14:23:09
#> id_a: 2020-02-21 14:23:10
#> id_a: 2020-02-21 14:23:11

runtime_gateway(run_mode = "while", id = "id_b")
#> id_b: 2020-02-21 14:23:12
#> id_b: 2020-02-21 14:23:13
#> id_b: 2020-02-21 14:23:14

runtime_gateway(run_mode = "while", at = lubridate::ymd_hms("2020-02-21 10:30:00"))
#> `at` was passed via ellipsis:
#> 2020-02-21 10:30:00
#> id_a: 2020-02-21 10:31:00
#> `at` was passed via ellipsis:
#> 2020-02-21 10:30:00
#> id_a: 2020-02-21 10:31:00
#> `at` was passed via ellipsis:
#> 2020-02-21 10:30:00
#> id_a: 2020-02-21 10:31:00

Created on 2020-02-21 by the reprex package (v0.3.0)

Upvotes: 3

Related Questions