Skip to content

Commit

Permalink
finalize cachely()
Browse files Browse the repository at this point in the history
  • Loading branch information
salim-b committed Jun 9, 2023
1 parent 3647ef5 commit 7abcb40
Show file tree
Hide file tree
Showing 12 changed files with 375 additions and 64 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

export(board)
export(cache_obj)
export(cachely)
export(clear_cache)
export(get_obj)
export(hash_fn_call)
Expand Down
66 changes: 65 additions & 1 deletion R/pkgpins.gen.R
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,71 @@ with_cache <- function(expr,
result
}


#' Add caching to a function
#'
#' One-stop solution to turn a function into one with caching. The caching is based on *all* arguments of `.fn`. Use [with_cache()] if you need more control.
#'
#' Note that the returned function has [`...`][dots] in its signature instead of `fn`'s original formals. Use [with_cache()] to create a function with a
#' specific signature.
#'
#' @inheritParams with_cache
#' @param fn_name Name of the function to cache, i.e. the name of `fn`. A character scalar.
#' @param fn A function.
#'
#' @return A modified version of `.fn` that uses caching.
#' @family high_lvl
#' @export
#'
#' @examples
#' # if the fn below would be part of a real package, we could instead define `this_pkg` globally
#' # using `this_pkg <- utils::packageName()`; instead, we now cache to pkgpins's cache (which
#' # itself never uses the cache)
#' this_pkg <- "pkgpins"
#'
#' # create a sleep function that caches sleeping (if only humans could do the same!)
#' sleepless <- pkgpins::cachely(pkg = this_pkg,
#' fn_name = "sleepless",
#' fn = \(x) { Sys.sleep(x); x },
#' max_cache_age = "1 year")
#' # populate the cache...
#' sleepless(0.5)
#' sleepless(3)
#'
#' # ... and never sleep the same amount of time again (for the next year)
#' sleepless(0.5)
#' sleepless(3)
#'
#' # note that the function gained additional caching-related arguments...
#' formals(sleepless)
#'
#' # ... so you can still coerce it to sleep
#' sleepless(3,
#' use_cache = FALSE)
#'
#' # purge cache from the above example
#' pkgpins::board(pkg = "pkgpins") |> pkgpins::purge_cache()
cachely <- function(pkg,
fn_name,
fn,
pkg_versioned = TRUE,
use_cache = TRUE,
max_cache_age = "1 day") {

checkmate::assert_function(fn)

rlang::new_function(args = rlang::pairlist2(... = ,
!!!rlang::exprs(use_cache = !!use_cache,
max_cache_age = !!max_cache_age)),
body = rlang::expr(expr = with_cache(expr = do.call(what = !!fn,
list(...)),
pkg = !!pkg,
from_fn = !!fn_name,
...,
pkg_versioned = !!pkg_versioned,
use_cache = use_cache,
max_cache_age = max_cache_age)),
env = parent.frame(n = 2L))
}

#' Get a package's user-cache pins board
#'
Expand Down
103 changes: 43 additions & 60 deletions Rmd/pkgpins.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -183,48 +183,22 @@ with_cache <- function(expr,
}
```

### !`cachely`
### `cachely`

EXPERIMENTAL; doesn't work as supposed (yet)!

TODO:

- Figure out how to properly pass on `...` to `fn()`; Currently only works with lambda fns, not with "normal" non-lambda fns:

``` r
sleepy <- function(x) { Sys.sleep(x); x }

sleepless <- pkgpins::cachely(.pkg = "pkgpins",
.fn_name = "sleepless",
.fn = sleepy,
.max_cache_age = "1 year")

sleepless(1)
sleepless(1)
```

- It probably makes sense to thoroughly read the chapter [Function factories](https://adv-r.hadley.nz/function-factories.html) of *Advanced R* at some point
in order to actually understand what we're doing here... 🤪
```{r, purl = FALSE}
```{r}
#' Add caching to a function
#'
#' Extends a function `.fn` by caching. Note that the caching is based on *all* arguments of `.fn`. Use [with_cache()] if you need more control.
#'
#' @param .pkg Package name to which `.fn` belongs. A character scalar.
#' @param .fn_name Name of the newly created function, i.e. the name for the function that is returned by `cachely()`. A character scalar.
#' @param .fn A function or formula.
#' One-stop solution to turn a function into one with caching. The caching is based on *all* arguments of `.fn`. Use [with_cache()] if you need more control.
#'
#' If a **function**, it is used as is.
#' Note that the returned function has [`...`][dots] in its signature instead of `fn`'s original formals. Use [with_cache()] to create a function with a
#' specific signature.
#'
#' If a **formula**, e.g. `~ .x + 2`, it is converted to a function with up to two arguments: `.x` (single argument) or `.x` and `.y` (two arguments). The
#' `.` placeholder can be used instead of `.x`. This allows you to create very compact anonymous functions (lambdas) with up to two inputs. See
#' [rlang::as_function()] for details.
#' @param ... Additional arguments passed on to `.fn`.
#' @param .use_cache `r pkgsnip::param_label("use_cache")`
#' @param .max_cache_age `r pkgsnip::param_label("max_cache_age")`
#' @inheritParams with_cache
#' @param fn_name Name of the function to cache, i.e. the name of `fn`. A character scalar.
#' @param fn A function.
#'
#' @return A modified version of `.fn` that uses caching.
#' @family high_lvl
#' @export
#'
#' @examples
Expand All @@ -234,39 +208,48 @@ TODO:
#' this_pkg <- "pkgpins"
#'
#' # create a sleep function that caches sleeping (if only humans could do the same!)
#' sleepless <- pkgpins::cachely(.pkg = this_pkg,
#' .fn_name = "sleepless",
#' .fn = ~ { Sys.sleep(.x); .x },
#' .max_cache_age = "1 year")
#'
#' sleepless <- pkgpins::cachely(pkg = this_pkg,
#' fn_name = "sleepless",
#' fn = \(x) { Sys.sleep(x); x },
#' max_cache_age = "1 year")
#' # populate the cache...
#' sleepless(0.5)
#' sleepless(1)
#' sleepless(3)
#'
#' # ... and never sleep the same amount of time again (for the next year)
#' sleepless(0.5)
#' sleepless(1)
#' sleepless(3)
#'
#' # note that the function gained additional caching-related arguments...
#' formals(sleepless)
#'
#' # ... so you can still coerce it to sleep
#' sleepless(3,
#' use_cache = FALSE)
#'
#' # purge cache from the above example
#' pkgpins::board(pkg = "pkgpins") |> pkgpins::purge_cache()
cachely <- function(.pkg,
.fn_name,
.fn,
...,
.use_cache = TRUE,
.max_cache_age = "1 day") {

fn <- rlang::as_function(.fn,
env = parent.frame())

rlang::new_function(args = rlang::fn_fmls(fn),
body = quote(expr = with_cache(expr = do.call(what = fn, # an alternative would be rlang::exec(), JFYI
args = rlang::fn_fmls_syms(fn)),
pkg = .pkg,
from_fn = .fn_name,
...,
use_cache = .use_cache,
max_cache_age = .max_cache_age)))
cachely <- function(pkg,
fn_name,
fn,
pkg_versioned = TRUE,
use_cache = TRUE,
max_cache_age = "1 day") {
checkmate::assert_function(fn)
rlang::new_function(args = rlang::pairlist2(... = ,
!!!rlang::exprs(use_cache = !!use_cache,
max_cache_age = !!max_cache_age)),
body = rlang::expr(expr = with_cache(expr = do.call(what = !!fn,
list(...)),
pkg = !!pkg,
from_fn = !!fn_name,
...,
pkg_versioned = !!pkg_versioned,
use_cache = use_cache,
max_cache_age = max_cache_age)),
env = parent.frame(n = 2L))
}
```

Expand Down
2 changes: 1 addition & 1 deletion docs/dev/pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ pandoc: 3.1.3
pkgdown: 2.0.7.9000
pkgdown_sha: 74872270eda08c87b0bd197b7ef4ab69e6c71996
articles: {}
last_built: 2023-06-08T21:04Z
last_built: 2023-06-09T01:19Z
urls:
reference: https://pkgpins.rpkg.dev/reference
article: https://pkgpins.rpkg.dev/articles
Expand Down
Loading

0 comments on commit 7abcb40

Please sign in to comment.