memoise/0000755000175000017500000000000014150203436012040 5ustar nileshnileshmemoise/MD50000644000175000017500000000255314150203436012355 0ustar nileshnilesh6af7ea17db88bc980ec0d017b644f9d9 *DESCRIPTION 722211a1118fa7bad3f44650438df16f *LICENSE 2f253245a9e17ba3fc75df0da7c6b583 *NAMESPACE 5960877e6e2d9acfc2550416d2acc253 *NEWS.md 8bb71330d7614d49297a17205a36c8c9 *R/cache_filesystem.R 887ee08a0a4c531b44a4cd7454c999ac *R/cache_gcs.R 1bb4901613571b2252d4dfbc0a06e29a *R/cache_memory.R 09a76cea7776560562373883e0bfe0d3 *R/cache_s3.R ace5e22223216404e5dd40c51d5833a2 *R/memoise.R bcfc169451ccef7e25f28ebce2159cbb *R/old_cache.R 9d5458be853a72b60035087b83e1b38a *README.md 61c1fe53b4f1a3979328deb28c104474 *man/cache_filesystem.Rd b2e1505ced2d501291b572c4ee548260 *man/cache_gcs.Rd 521d9869c3b32561ae749eaa3f91c5a1 *man/cache_memory.Rd 7c7911ce070686dfe1c5ae01c1152e0e *man/cache_s3.Rd 41d97b90ff962c12e0c386ca5da54f0c *man/drop_cache.Rd 8f1b97112e48cd9311ca2de76f668c43 *man/forget.Rd 9b50b07afa7bf2ec6ec8e37bd372a2fd *man/has_cache.Rd 8fbdeb4e4ac5c9596adbac2b97c86f9a *man/is.memoised.Rd 016fc8cb609c86f6ebb73c3368526d8d *man/memoise.Rd 7173ef6c72af631d5ffbeccf66ec7d1b *man/timeout.Rd c4111f4662e1dada1a4d23df123018f9 *tests/testthat.R 38774c6551795a4f394b370bef8cf7f3 *tests/testthat/helper.R cca05a4aa2a997358590cb5c64dab374 *tests/testthat/test-filesystem.R e185b03ee62b7ec63f3eca07241b48d0 *tests/testthat/test-gcs.R 03f6c7f0dec371ee548caa90d2c595c4 *tests/testthat/test-memoise.R 9c45e2b40de7c40237ca44a32d20d44e *tests/testthat/test-s3.R memoise/NEWS.md0000644000175000017500000000567214147526612013162 0ustar nileshnilesh# memoise 2.0.1 # Version 2.0.0.9000 * Winston Chang is now the maintainer. * The default value for the `hash` argument of `memoise()` is now taken with an indirection in case `memoise()` is called at the top-level of a namespace (r-lib/rlang#1177). * Fixed a bug in `has_cache()` that caused it to get the value unnecessarily. (#123) # Version 2.0.0 * Memoise now uses caching objects from the cachem package by default. These caches support automatic pruning, so that they won't grow indefinitely. The older-style cache objects in the memoise package are still supported, but we suggest using new-style caches from cachem. (#115) * Name clashes between function arguments and variables defined when memoising no longer occur (@egnha, #43). * Add Google Cloud Storage support via `cache_gcs()` (@MarkEdmondson1234, #59) * Add `compress` option for non-memory caches (@coolbutuseless, #71). * Use absolute path in cache file system backend, so user can change working directory after using relative path (@xhdong-umd, #51, #65) * Add `drop_cache()` to drop the cached result for particular arguments (@richardkunze, #78) * Suppress messages of `aws.s3::head_object` within `cache_s3`'s `cache_has_key` to avoid printing of 404 messages for new keys (@stelsemeyer, #96). # Version 1.1.0 * Caches now hash the function body along with the arguments, to ensure functions with identical arguments use a separate file-system cache. (#38) * Handle missing arguments in memoised functions for simple cases not using non-standard-evaluation (#19). * `memoise()` gains a `cache=` argument to specify an external cache. Two types of caches are available, `cache_s3()` for amazon S3 and `cache_filesystem()` for a file system cache (#25, @danielecook). # Version 1.0.0 * `memoise()` now signals an error if an already memoised function is used as input (#4, @richierocks). * `has_cache()` function added which returns a boolean depending on if the given call is cached or not (#10, @dkesh). * Memoised functions now have a print method which displays the original function definition, rather than the memoisation code (#15, @jimhester). * A memoised function now has the same interface as the original function, if the original function is known when `memoise` is called. (Otherwise, the old behavior is invoked, with a warning.) (#14, @krlmlr) * The enclosing environment of the memoised function is specified explicitly, defaults to `parent.frame()`. * `is.memoised` now checks if the argument is a function. * Testing infrastructure, full test coverage. # Version 0.2.1 * Update to fix outstanding R CMD check issues. # Version 0.2 (2010-11-11) ## New features * Memoised functions now have an attribute memoised=TRUE, and is.memoised() tests whether a function is memoised. (Contributed by Sietse Brouwer.) ## Improvements * Documentation is now more elaborate, and hopefully more accessible to newcomers. Thanks to Sietse Brouwer for the verbosity. memoise/DESCRIPTION0000644000175000017500000000312314150203436013545 0ustar nileshnileshPackage: memoise Title: 'Memoisation' of Functions Version: 2.0.1 Authors@R: c(person(given = "Hadley", family = "Wickham", role = "aut", email = "hadley@rstudio.com"), person(given = "Jim", family = "Hester", role = "aut"), person(given = "Winston", family = "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"), person(given = "Kirill", family = "Müller", role = "aut", email = "krlmlr+r@mailbox.org"), person(given = "Daniel", family = "Cook", role = "aut", email = "danielecook@gmail.com"), person(given = "Mark", family = "Edmondson", role = "ctb", email = "r@sunholo.com")) Description: Cache the results of a function so that when you call it again with the same arguments it returns the previously computed value. License: MIT + file LICENSE URL: https://memoise.r-lib.org, https://github.com/r-lib/memoise BugReports: https://github.com/r-lib/memoise/issues Imports: rlang (>= 0.4.10), cachem Suggests: digest, aws.s3, covr, googleAuthR, googleCloudStorageR, httr, testthat Encoding: UTF-8 RoxygenNote: 7.1.2 NeedsCompilation: no Packaged: 2021-11-24 21:24:50 UTC; jhester Author: Hadley Wickham [aut], Jim Hester [aut], Winston Chang [aut, cre], Kirill Müller [aut], Daniel Cook [aut], Mark Edmondson [ctb] Maintainer: Winston Chang Repository: CRAN Date/Publication: 2021-11-26 16:11:10 UTC memoise/README.md0000644000175000017500000001310414147526235013331 0ustar nileshnilesh # memoise [![CRAN status](https://www.r-pkg.org/badges/version/memoise)](https://CRAN.R-project.org/package=memoise) [![R build status](https://github.com/r-lib/memoise/workflows/R-CMD-check/badge.svg)](https://github.com/r-lib/memoise/actions) [![Codecov test coverage](https://codecov.io/gh/r-lib/memoise/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-lib/memoise?branch=main) The memoise package makes it easy to memoise R functions. **Memoisation** () caches function calls so that if a previously seen set of inputs is seen, it can return the previously computed output. # Installation Install from CRAN with ``` r install.packages("memoise") ``` ## Usage To memoise a function, use `memoise()`: ``` r library(memoise) f <- function(x) { Sys.sleep(1) mean(x) } mf <- memoise(f) ``` ``` r system.time(mf(1:10)) #> user system elapsed #> 0.002 0.000 1.003 system.time(mf(1:10)) #> user system elapsed #> 0.000 0.000 0.001 ``` You can clear `mf`’s cache with: ``` r forget(mf) ``` And you can test whether a function is memoised with `is.memoised()`. ## Caches By default, memoise uses an in-memory cache, using `cache_mem()` from the [cachem](https://cachem.r-lib.org/) package. `cachem::cache_disk()` allows caching using files on a local filesystem. Both `cachem::cache_mem()` and `cachem::cache_disk()` support automatic pruning by default; this means that they will not keep growing past a certain size, and eventually older items will be removed from the cache. The default size `cache_mem()` is 512 MB, and the default size for a `cache_disk()` is 1 GB, but this can be customized by specifying `max_size`: ``` r # 100 MB limit cm <- cachem::cache_mem(max_size = 100 * 1024^2) mf <- memoise(f, cache = cm) ``` You can also change the maximum age of items in the cache with `max_age`: ``` r # Expire items in cache after 15 minutes cm <- cachem::cache_mem(max_age = 15 * 60) mf <- memoise(f, cache = cm) ``` By default, a `cache_disk()` uses a subdirectory the R process’s temp directory, but it is possible to specify the directory. This is useful for persisting a cache across R sessions, sharing a cache among different processes, or even for synchronizing across the network. ``` r # Store in "R-myapp" directory inside of user-level cache directory cd <- cachem::cache_disk(rappdirs::user_cache_dir("R-myapp")) # Store in Dropbox cdb <- cachem::cache_disk("~/Dropbox/.rcache") ``` A single cache object can be shared among multiple memoised functions. By default, the cache key includes not only the arguments to the function, but also the body of the function. This essentially eliminates the possibility of a cache collision, even if two memoised functions are called with the same arguments. ``` r m <- cachem::cache_mem() times2 <- memoise(function(x) { x * 2 }, cache = m) times4 <- memoise(function(x) { x * 4 }, cache = m) times2(10) #> [1] 20 times4(10) #> [1] 40 ``` ### Cache API It is possible to use other caching backends with memoise. These caching objects must be key-value stores which use the same API as those from the [cachem](https://cachem.r-lib.org/) package. The following methods are required for full compatibiltiy with memoise: - `$set(key, value)`: Sets a `key` to `value` in the cache. - `$get(key)`: Gets the value associated with `key`. If the key is not in the cache, this returns an object with class `"key_missing"`. - `$exists(key)`: Checks for the existence of `key` in the cache. - `$remove(key)`: Removes the value for `key` from the cache. - `$reset()`: Resets the cache, clearing all key/value pairs. Note that the sentinel value for missing keys can be created by calling `cachem::key_missing()`, or `structure(list(), class = "key_missing")`. ### Old-style cache objects Before version 2.0, memoise used different caching objects, which did not have automatic pruning and had a slightly different API. These caching objects can still be used, but we recommend using the caching objects from cachem when possible. With the old-style caching objects, memoise first checks for the existence of a key in the cache, and if present, it fetches the value. This results in a possible race condition (when using caches other than the memory cache): an object could be deleted from the cache after the existence check, but before the value is fetched. With the new cachem-style caching objects, the possibility of a a race condition is eliminated: memoise simply tries to fetch the key, and if it’s not present in the cache, the cache returns a sentinel value indicating that it’s missing. (Note that the caching objects must also be designed to avoid a similar race condition internally.) The following cache objects do not currently have an equivalent in cachem. - `cache_s3()` allows caching on [Amazon S3](https://aws.amazon.com/s3/) Requires you to specify a bucket using `cache_name`. When creating buckets, they must be unique among all s3 users when created. ``` r Sys.setenv( "AWS_ACCESS_KEY_ID" = "", "AWS_SECRET_ACCESS_KEY" = "" ) cache <- cache_s3("") ``` - `cache_gcs()` saves the cache to Google Cloud Storage. It requires you to authenticate by downloading a JSON authentication file, and specifying a pre-made bucket: ``` r Sys.setenv( "GCS_AUTH_FILE" = "", "GCS_DEFAULT_BUCKET" = "unique-bucket-name" ) gcs <- cache_gcs() ``` memoise/man/0000755000175000017500000000000014147524623012625 5ustar nileshnileshmemoise/man/has_cache.Rd0000644000175000017500000000126614147524623015017 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{has_cache} \alias{has_cache} \title{Test whether a memoised function has been cached for particular arguments.} \usage{ has_cache(f) } \arguments{ \item{f}{Function to test.} } \value{ A function, with the same arguments as \code{f}, that can be called to test if \code{f} has cached results. } \description{ Test whether a memoised function has been cached for particular arguments. } \examples{ mem_sum <- memoise(sum) has_cache(mem_sum)(1, 2, 3) # FALSE mem_sum(1, 2, 3) has_cache(mem_sum)(1, 2, 3) # TRUE } \seealso{ \code{\link{is.memoised}}, \code{\link{memoise}}, \code{\link{drop_cache}} } memoise/man/forget.Rd0000644000175000017500000000136614147524623014410 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{forget} \alias{forget} \title{Forget past results. Resets the cache of a memoised function. Use \code{\link{drop_cache}} to reset the cache only for particular arguments.} \usage{ forget(f) } \arguments{ \item{f}{memoised function} } \description{ Forget past results. Resets the cache of a memoised function. Use \code{\link{drop_cache}} to reset the cache only for particular arguments. } \examples{ memX <- memoise(function() { Sys.sleep(1); runif(1) }) # The forget() function system.time(print(memX())) system.time(print(memX())) forget(memX) system.time(print(memX())) } \seealso{ \code{\link{memoise}}, \code{\link{is.memoised}}, \code{\link{drop_cache}} } memoise/man/cache_memory.Rd0000644000175000017500000000062314147523405015545 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cache_memory.R \name{cache_memory} \alias{cache_memory} \title{In Memory Cache} \usage{ cache_memory(algo = "sha512") } \arguments{ \item{algo}{The hashing algorithm used for the cache, see \code{\link[digest]{digest}} for available algorithms.} } \description{ A cache in memory, that lasts only in the current R session. } memoise/man/drop_cache.Rd0000644000175000017500000000140514147523405015200 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{drop_cache} \alias{drop_cache} \title{Drops the cache of a memoised function for particular arguments.} \usage{ drop_cache(f) } \arguments{ \item{f}{Memoised function.} } \value{ A function, with the same arguments as \code{f}, that can be called to drop the cached results of \code{f}. } \description{ Drops the cache of a memoised function for particular arguments. } \examples{ mem_sum <- memoise(sum) mem_sum(1, 2, 3) mem_sum(2, 3, 4) has_cache(mem_sum)(1, 2, 3) # TRUE has_cache(mem_sum)(2, 3, 4) # TRUE drop_cache(mem_sum)(1, 2, 3) # TRUE has_cache(mem_sum)(1, 2, 3) # FALSE has_cache(mem_sum)(2, 3, 4) # TRUE } \seealso{ \code{\link{has_cache}}, \code{\link{memoise}} } memoise/man/cache_filesystem.Rd0000644000175000017500000000155014147523405016421 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cache_filesystem.R \name{cache_filesystem} \alias{cache_filesystem} \title{Filesystem Cache} \usage{ cache_filesystem(path, algo = "xxhash64", compress = FALSE) } \arguments{ \item{path}{Directory in which to store cached items.} \item{algo}{The hashing algorithm used for the cache, see \code{\link[digest]{digest}} for available algorithms.} \item{compress}{Argument passed to \code{saveRDS}. One of FALSE, "gzip", "bzip2" or "xz". Default: FALSE.} } \description{ Use a cache on the local filesystem that will persist between R sessions. } \examples{ \dontrun{ # Use with Dropbox db <- cache_filesystem("~/Dropbox/.rcache") mem_runif <- memoise(runif, cache = db) # Use with Google Drive gd <- cache_filesystem("~/Google Drive/.rcache") mem_runif <- memoise(runif, cache = gd) } } memoise/man/is.memoised.Rd0000644000175000017500000000130014147523405015317 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{is.memoised} \alias{is.memoised} \alias{is.memoized} \title{Test whether a function is a memoised copy. Memoised copies of functions carry an attribute \code{memoised = TRUE}, which is what \code{is.memoised()} tests for.} \usage{ is.memoised(f) } \arguments{ \item{f}{Function to test.} } \description{ Test whether a function is a memoised copy. Memoised copies of functions carry an attribute \code{memoised = TRUE}, which is what \code{is.memoised()} tests for. } \examples{ mem_lm <- memoise(lm) is.memoised(lm) # FALSE is.memoised(mem_lm) # TRUE } \seealso{ \code{\link{memoise}}, \code{\link{forget}} } memoise/man/cache_gcs.Rd0000644000175000017500000000174314147523405015015 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cache_gcs.R \name{cache_gcs} \alias{cache_gcs} \title{Google Cloud Storage Cache Google Cloud Storage backed cache, for remote caching.} \usage{ cache_gcs( cache_name = googleCloudStorageR::gcs_get_global_bucket(), algo = "sha512", compress = FALSE ) } \arguments{ \item{cache_name}{Bucket name for storing cache files.} \item{algo}{The hashing algorithm used for the cache, see \code{\link[digest]{digest}} for available algorithms.} \item{compress}{Argument passed to \code{saveRDS}. One of FALSE, "gzip", "bzip2" or "xz". Default: FALSE.} } \description{ Google Cloud Storage Cache Google Cloud Storage backed cache, for remote caching. } \examples{ \dontrun{ library(googleCloudStorageR) # Set GCS credentials. Sys.setenv("GCS_AUTH_FILE"="", "GCS_DEFAULT_BUCKET"="unique-bucket-name") gcs <- cache_gcs("unique-bucket-name") mem_runif <- memoise(runif, cache = gcs) } } memoise/man/timeout.Rd0000644000175000017500000000153114147523405014577 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{timeout} \alias{timeout} \title{Return a new number after a given number of seconds} \usage{ timeout(seconds, current = as.numeric(Sys.time())) } \arguments{ \item{seconds}{Number of seconds after which to timeout.} \item{current}{The current time as a numeric.} } \value{ A numeric that will remain constant until the seconds have elapsed. } \description{ This function will return a number corresponding to the system time and remain stable until a given number of seconds have elapsed, after which it will update to the current time. This makes it useful as a way to timeout and invalidate a memoised cache after a certain period of time. } \examples{ a <- function(n) { runif(n) } memA <- memoise(a, ~timeout(10)) memA(2) } \seealso{ \code{\link{memoise}} } memoise/man/memoise.Rd0000644000175000017500000001123114147524623014550 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/memoise.R \name{memoise} \alias{memoise} \alias{memoize} \title{Memoise a function} \usage{ memoise( f, ..., envir = environment(f), cache = cachem::cache_mem(max_size = 1024 * 1024^2), omit_args = c(), hash = function(x) rlang::hash(x) ) } \arguments{ \item{f}{Function of which to create a memoised copy.} \item{...}{optional variables to use as additional restrictions on caching, specified as one-sided formulas (no LHS). See Examples for usage.} \item{envir}{Environment of the returned function.} \item{cache}{Cache object. The default is a [cachem::cache_mem()] with a max size of 1024 MB.} \item{omit_args}{Names of arguments to ignore when calculating hash.} \item{hash}{A function which takes an R object as input and returns a string which is used as a cache key.} } \description{ \code{mf <- memoise(f)} creates \code{mf}, a memoised copy of \code{f}. A memoised copy is basically a lazier version of the same function: it saves the answers of new invocations, and re-uses the answers of old ones. Under the right circumstances, this can provide a very nice speedup indeed. } \details{ There are two main ways to use the \code{memoise} function. Say that you wish to memoise \code{glm}, which is in the \code{stats} package; then you could use \cr \code{ mem_glm <- memoise(glm)}, or you could use\cr \code{ glm <- memoise(stats::glm)}. \cr The first form has the advantage that you still have easy access to both the memoised and the original function. The latter is especially useful to bring the benefits of memoisation to an existing block of R code. Two example situations where \code{memoise} could be of use: \itemize{ \item You're evaluating a function repeatedly over the rows (or larger chunks) of a dataset, and expect to regularly get the same input. \item You're debugging or developing something, which involves a lot of re-running the code. If there are a few expensive calls in there, memoising them can make life a lot more pleasant. If the code is in a script file that you're \code{source()}ing, take care that you don't just put \cr \code{ glm <- memoise(stats::glm)} \cr at the top of your file: that would reinitialise the memoised function every time the file was sourced. Wrap it in \cr \code{ if (!is.memoised(glm)) }, or do the memoisation call once at the R prompt, or put it somewhere else where it won't get repeated. } It is recommended that functions in a package are not memoised at build-time, but when the package is loaded. The simplest way to do this is within \code{.onLoad()} with, for example \preformatted{ # file.R fun <- function() { some_expensive_process() } # zzz.R .onLoad <- function(libname, pkgname) { fun <<- memoise::memoise(fun) } } } \examples{ # a() is evaluated anew each time. memA() is only re-evaluated # when you call it with a new set of parameters. a <- function(n) { runif(n) } memA <- memoise(a) replicate(5, a(2)) replicate(5, memA(2)) # Caching is done based on parameters' value, so same-name-but- # changed-value correctly produces two different outcomes... N <- 4; memA(N) N <- 5; memA(N) # ... and same-value-but-different-name correctly produces # the same cached outcome. N <- 4; memA(N) N2 <- 4; memA(N2) # memoise() knows about default parameters. b <- function(n, dummy="a") { runif(n) } memB <- memoise(b) memB(2) memB(2, dummy="a") # This works, because the interface of the memoised function is the same as # that of the original function. formals(b) formals(memB) # However, it doesn't know about parameter relevance. # Different call means different caching, no matter # that the outcome is the same. memB(2, dummy="b") # You can create multiple memoisations of the same function, # and they'll be independent. memA(2) memA2 <- memoise(a) memA(2) # Still the same outcome memA2(2) # Different cache, different outcome # Multiple memoized functions can share a cache. cm <- cachem::cache_mem(max_size = 50 * 1024^2) memA <- memoise(a, cache = cm) memB <- memoise(b, cache = cm) # Don't do the same memoisation assignment twice: a brand-new # memoised function also means a brand-new cache, and *that* # you could as easily and more legibly achieve using forget(). # (If you're not sure whether you already memoised something, # use is.memoised() to check.) memA(2) memA <- memoise(a) memA(2) # Make a memoized result automatically time out after 10 seconds. memA3 <- memoise(a, cache = cachem::cache_mem(max_age = 10)) memA3(2) } \seealso{ \code{\link{forget}}, \code{\link{is.memoised}}, \code{\link{timeout}}, \url{https://en.wikipedia.org/wiki/Memoization}, \code{\link{drop_cache}} } memoise/man/cache_s3.Rd0000644000175000017500000000165614147523405014571 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cache_s3.R \name{cache_s3} \alias{cache_s3} \title{Amazon Web Services S3 Cache Amazon Web Services S3 backed cache, for remote caching.} \usage{ cache_s3(cache_name, algo = "sha512", compress = FALSE) } \arguments{ \item{cache_name}{Bucket name for storing cache files.} \item{algo}{The hashing algorithm used for the cache, see \code{\link[digest]{digest}} for available algorithms.} \item{compress}{Argument passed to \code{saveRDS}. One of FALSE, "gzip", "bzip2" or "xz". Default: FALSE.} } \description{ Amazon Web Services S3 Cache Amazon Web Services S3 backed cache, for remote caching. } \examples{ \dontrun{ # Set AWS credentials. Sys.setenv("AWS_ACCESS_KEY_ID" = "", "AWS_SECRET_ACCESS_KEY" = "") # Set up a unique bucket name. s3 <- cache_s3("unique-bucket-name") mem_runif <- memoise(runif, cache = s3) } } memoise/tests/0000755000175000017500000000000012634167536013221 5ustar nileshnileshmemoise/tests/testthat/0000755000175000017500000000000014150203436015042 5ustar nileshnileshmemoise/tests/testthat/test-s3.R0000644000175000017500000000115414147523405016477 0ustar nileshnileshcontext("s3") test_that("using a s3 cache works", { skip_on_cran() skip_on_travis_pr() skip_without_aws_credentials() aws <- cache_s3("memoise-tests") i <- 0 fn <- function() { i <<- i + 1; i } fnm <- memoise(fn, cache = aws) on.exit(forget(fnm)) expect_equal(fn(), 1) expect_equal(fn(), 2) expect_equal(fnm(), 3) expect_equal(fnm(), 3) expect_equal(fn(), 4) expect_equal(fnm(), 3) expect_false(forget(fn)) expect_true(forget(fnm)) expect_equal(fnm(), 5) expect_true(drop_cache(fnm)()) expect_equal(fnm(), 6) expect_true(is.memoised(fnm)) expect_false(is.memoised(fn)) }) memoise/tests/testthat/test-gcs.R0000644000175000017500000000140614147523405016726 0ustar nileshnileshcontext("gcs") test_that("using a gcs cache works", { skip_on_cran() skip_on_travis_pr() skip_without_gcs_credentials() googleAuthR::gar_set_client(scopes = "https://www.googleapis.com/auth/cloud-platform") googleAuthR::gar_auth_service(Sys.getenv("GCS_AUTH_FILE")) aws <- cache_gcs("memoise-tests") i <- 0 fn <- function() { i <<- i + 1; i } fnm <- memoise(fn, cache = aws) on.exit(forget(fnm)) expect_equal(fn(), 1) expect_equal(fn(), 2) expect_equal(fnm(), 3) expect_equal(fnm(), 3) expect_equal(fn(), 4) expect_equal(fnm(), 3) expect_false(forget(fn)) expect_true(forget(fnm)) expect_equal(fnm(), 5) expect_true(drop_cache(fnm)()) expect_equal(fnm(), 6) expect_true(is.memoised(fnm)) expect_false(is.memoised(fn)) }) memoise/tests/testthat/helper.R0000644000175000017500000000150214147523405016451 0ustar nileshnileshskip_without_gcs_credentials <- function() { # -# Sys.setenv("GCS_AUTH_FILE" = "", "GCS_DEFAULT_BUCKET" = "bucket name") if (nzchar(Sys.getenv("GCS_AUTH_FILE")) && nzchar(Sys.getenv("GCS_DEFAULT_BUCKET"))) { return(invisible(TRUE)) } testthat::skip("No GCS Credentials") } skip_without_aws_credentials <- function() { # -# Sys.setenv("AWS_ACCESS_KEY_ID" = "", "AWS_SECRET_ACCESS_KEY" = "") if (nzchar(Sys.getenv("AWS_ACCESS_KEY_ID")) && nzchar(Sys.getenv("AWS_SECRET_ACCESS_KEY"))) { return(invisible(TRUE)) } testthat::skip("No AWS Credentials") } skip_on_travis_pr <- function() { if (identical(Sys.getenv("TRAVIS"), "true") && !identical(Sys.getenv("TRAVIS_PULL_REQUEST", "false"), "false")) { return(testthat::skip("On Travis PR")) } invisible(TRUE) } memoise/tests/testthat/test-memoise.R0000644000175000017500000002450214147524623017615 0ustar nileshnileshcontext("memoise") test_that("memoisation works", { fn <- function() { i <<- i + 1; i } i <- 0 expect_warning(fnm <- memoise(fn), NA) expect_equal(fn(), 1) expect_equal(fn(), 2) expect_equal(fnm(), 3) expect_equal(fnm(), 3) expect_equal(fn(), 4) expect_equal(fnm(), 3) expect_false(forget(fn)) expect_true(forget(fnm)) expect_true(forget(fnm)) expect_equal(fnm(), 5) expect_true(is.memoised(fnm)) expect_false(is.memoised(fn)) }) test_that("memoisation depends on argument", { fn <- function(j) { i <<- i + 1; i } i <- 0 expect_warning(fnm <- memoise(fn), NA) expect_equal(fn(1), 1) expect_equal(fn(1), 2) expect_equal(fnm(1), 3) expect_equal(fnm(1), 3) expect_equal(fn(1), 4) expect_equal(fnm(1), 3) expect_equal(fnm(2), 5) expect_equal(fnm(2), 5) expect_equal(fnm(1), 3) expect_equal(fn(2), 6) }) test_that("interface of wrapper matches interface of memoised function", { fn <- function(j) { i <<- i + 1; i } i <- 0 expect_equal(formals(fn), formals(memoise(fn))) expect_equal(formals(runif), formals(memoise(runif))) expect_equal(formals(paste), formals(memoise(paste))) }) test_that("dot arguments are used for hash", { fn <- function(...) { i <<- i + 1; i } i <- 0 expect_warning(fnm <- memoise(fn), NA) expect_equal(fn(1), 1) expect_equal(fnm(1), 2) expect_equal(fnm(1), 2) expect_equal(fnm(1, 2), 3) expect_equal(fnm(1), 2) expect_equal(fnm(1, 2), 3) expect_equal(fnm(), 4) expect_true(forget(fnm)) expect_equal(fnm(1), 5) expect_equal(fnm(1, 2), 6) expect_equal(fnm(), 7) }) test_that("default arguments are used for hash", { fn <- function(j = 1) { i <<- i + 1; i } i <- 0 expect_warning(fnm <- memoise(fn), NA) expect_equal(fn(1), 1) expect_equal(fnm(1), 2) expect_equal(fnm(1), 2) expect_equal(fnm(), 2) expect_equal(fnm(2), 3) expect_equal(fnm(), 2) }) test_that("default arguments are evaluated correctly", { expect_false(exists("g")) g <- function() 1 fn <- function(j = g()) { i <<- i + 1; i } i <- 0 expect_warning(fnm <- memoise(fn), NA) expect_equal(fn(1), 1) expect_equal(fnm(1), 2) expect_equal(fnm(1), 2) expect_equal(fnm(), 2) expect_equal(fnm(2), 3) expect_equal(fnm(), 2) }) test_that("symbol collision", { cache <- function(j = 1) { i <<- i + 1; i } i <- 0 cachem <- memoise(cache) expect_equal(cache(), 1) expect_equal(cache(), 2) expect_equal(cachem(), 3) expect_equal(cachem(), 3) expect_equal(cache(), 4) expect_equal(cachem(), 3) expect_true(forget(cachem)) expect_equal(cachem(), 5) }) test_that("different body avoids collisions", { # Same args, different body m <- cachem::cache_mem() times2 <- memoise(function(x) { x * 2 }, cache = m) times4 <- memoise(function(x) { x * 4 }, cache = m) expect_identical(times2(10), 20) expect_equal(m$size(), 1) expect_identical(times4(10), 40) expect_equal(m$size(), 2) }) test_that("different formals avoids collisions", { # Different formals (even if not used) avoid collisions, because formals # are used in key. m <- cachem::cache_mem() f <- function(x, y) { x * 2 } times2 <- memoise(function(x, y) { x * 2 }, cache = m) times2a <- memoise(function(x, y = 1) { x * 2 }, cache = m) expect_identical(times2(10), 20) expect_equal(m$size(), 1) expect_identical(times2a(10), 20) expect_equal(m$size(), 2) }) test_that("same body results in collisions", { # Two identical memoised functions should result in cache hits so that cache # can be shared more easily. # https://github.com/r-lib/memoise/issues/58 m <- cachem::cache_mem() times2 <- memoise(function(x, y) { x * 2 }, cache = m) times2a <- memoise(function(x, y) { x * 2 }, cache = m) expect_identical(times2(10), 20) expect_identical(times2a(10), 20) expect_equal(m$size(), 1) }) test_that("same body results in collisions", { # Even though t2 and t4 produce different results, the memoised versions, # times2 and times4, have cache collisions because the functions have the same # body and formals. It would be nice if we could somehow avoid this. m <- cachem::cache_mem() t2 <- local({ n <- 2 function(x) x * n }) t4 <- local({ n <- 4 function(x) x * n }) times2 <- memoise(t2, cache = m) times4 <- memoise(t4, cache = m) expect_identical(times2(10), 20) expect_identical(times4(10), 20) # Bad (but expected) cache collision! expect_equal(m$size(), 1) }) test_that("visibility", { vis <- function() NULL invis <- function() invisible() expect_true(withVisible(memoise(vis)())$visible) expect_false(withVisible(memoise(invis)())$visible) }) test_that("is.memoised", { i <- 0 expect_false(is.memoised(i)) expect_false(is.memoised(is.memoised)) expect_true(is.memoised(memoise(identical))) }) test_that("visibility", { vis <- function() NULL invis <- function() invisible() expect_true(withVisible(memoise(vis)())$visible) expect_false(withVisible(memoise(invis)())$visible) }) test_that("can memoise anonymous function", { expect_warning(fm <- memoise(function(a = 1) a), NA) expect_equal(names(formals(fm))[[1]], "a") expect_equal(fm(1), 1) expect_equal(fm(2), 2) expect_equal(fm(1), 1) }) test_that("can memoise primitive", { expect_warning(fm <- memoise(`+`), NA) expect_equal(names(formals(fm)), names(formals(args(`+`)))) expect_equal(fm(1, 2), 1 + 2) expect_equal(fm(2, 3), 2 + 3) expect_equal(fm(1, 2), 1 + 2) }) test_that("printing a memoised function prints the original definition", { fn <- function(j) { i <<- i + 1; i } fnm <- memoise(fn) fn_output <- capture.output(fn) fnm_output <- capture.output(fnm) expect_equal(fnm_output[1], "Memoised Function:") expect_equal(fnm_output[-1], fn_output) }) test_that("memoisation can depend on non-arguments", { fn <- function(x) { i <<- i + 1; i } i <- 0 j <- 2 fn2 <- function(y, ...) { fnm <- memoise(fn, ~y) fnm(...) } expect_error(memoise(fn, j), "`j` must be a formula\\.") expect_error(memoise(fn, ~j, k), "`k` must be a formula\\.") expect_error(memoise(fn, j ~ 1), "`x` must be a one sided formula \\[not j ~ 1\\]\\.") fnm <- memoise(fn, ~j) expect_equal(fn(1), 1) expect_equal(fn(1), 2) expect_equal(fnm(1), 3) expect_equal(fnm(1), 3) j <- 1 expect_equal(fnm(1), 4) expect_equal(fnm(1), 4) j <- 2 expect_equal(fnm(1), 3) expect_equal(fnm(1), 3) j <- 3 expect_equal(fnm(1), 5) expect_equal(fnm(1), 5) }) test_that("it fails if already memoised", { mem_sum <- memoise(sum) expect_error(memoise(mem_sum), "`f` must not be memoised.") }) test_that("it evaluates arguments in proper environment", { e <- new.env(parent = baseenv()) e$a <- 5 fun <- function(x, y = a) { x + y } environment(fun) <- e fun_mem <- memoise(fun) expect_equal(fun(1), fun_mem(1)) expect_equal(fun(10), fun_mem(10)) }) test_that("it does have namespace clashes with internal memoise symbols", { e <- new.env(parent = baseenv()) e$f <- 5 fun <- function(x, y = f) { x + y } environment(fun) <- e fun_mem <- memoise(fun) expect_equal(fun(1), fun_mem(1)) expect_equal(fun(10), fun_mem(10)) }) test_that("arguments are evaluated before hashing", { i <- 1 f <- memoise(function(x, y, z = 3) { x + y + z}) f2 <- function(x, y) f(x, y) expect_equal(f2(1, 1), 5) expect_equal(f2(1, 1), 5) expect_equal(f2(2, 2), 7) }) test_that("argument names don't clash with names in memoised function body", { f <- function( # Names in enclosing environment of memoising function `_f`, `_cache`, `_additional`, # Names in body of memoising function mc, encl, called_args, default_args, args, hash, res ) list(`_f`, `_cache`, `_additional`, mc, encl, called_args, default_args, args, hash, res) f_mem <- memoise(f) expect_error(f_mem(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), NA) expect_identical(f(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), f_mem(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)) }) test_that("omit_args respected", { # If no arguments ignored, these 2 rnorm() calls should have different results mem_rnorm <- memoise(rnorm, omit_args = c()) res1 <- mem_rnorm(10, mean = -100) res2 <- mem_rnorm(10, mean = +100) expect_false(identical(res1, res2)) # If 'mean' ignored when hashing, these 2 rnorm() calls will have identical results mem_rnorm <- memoise(rnorm, omit_args = c('mean')) res1 <- mem_rnorm(10, mean = -100) res2 <- mem_rnorm(10, mean = +100) expect_true(identical(res1, res2)) }) context("has_cache") test_that("it works as expected with memoised functions", { mem_sum <- memoise(sum) expect_false(has_cache(mem_sum)(1, 2, 3)) mem_sum(1, 2, 3) expect_true(has_cache(mem_sum)(1, 2, 3)) mem_sum <- memoise(sum) expect_false(has_cache(mem_sum)(1, 2, 3)) }) test_that("it errors with an un-memoised function", { expect_error(has_cache(sum)(1, 2, 3), "`f` is not a memoised function.") }) context("drop_cache") test_that("it works as expected with memoised functions", { mem_sum <- memoise(sum) expect_false(drop_cache(mem_sum)(1, 2, 3)) mem_sum(1, 2, 3) mem_sum(2, 3, 4) expect_true(has_cache(mem_sum)(1, 2, 3)) expect_true(has_cache(mem_sum)(2, 3, 4)) expect_true(drop_cache(mem_sum)(1, 2, 3)) expect_false(has_cache(mem_sum)(1, 2, 3)) expect_true(has_cache(mem_sum)(2, 3, 4)) mem_sum <- memoise(sum) expect_false(drop_cache(mem_sum)(1, 2, 3)) }) test_that("it errors with an un-memoised function", { expect_error(drop_cache(sum)(1, 2, 3), "`f` is not a memoised function.") }) context("timeout") test_that("it stays the same if not enough time has passed", { duration <- 10 first <- timeout(duration, 0) expect_equal(first, timeout(duration, 1)) expect_equal(first, timeout(duration, 5)) expect_equal(first, timeout(duration, 7)) expect_equal(first, timeout(duration, 9)) expect_true(first != timeout(duration, 10)) duration <- 100 first <- timeout(duration, 0) expect_equal(first, timeout(duration, 10)) expect_equal(first, timeout(duration, 50)) expect_equal(first, timeout(duration, 70)) expect_equal(first, timeout(duration, 99)) expect_true(first != timeout(duration, 100)) }) context("missing") test_that("it works with missing arguments", { fn <- function(x, y) { i <<- i + 1 if (missing(y)) { y <- 1 } x + y } fnm <- memoise(fn) i <- 0 expect_equal(fn(1), fnm(1)) expect_equal(fn(1, 2), fnm(1, 2)) expect_equal(i, 4) fnm(1) expect_equal(i, 4) fnm(1, 2) expect_equal(i, 4) }) memoise/tests/testthat/test-filesystem.R0000644000175000017500000000156514147523405020344 0ustar nileshnileshcontext("filesystem") test_that("using a filesystem cache works", { fs <- cache_filesystem(tempfile()) i <- 0 fn <- function() { i <<- i + 1; i } fnm <- memoise(fn, cache = fs) on.exit(forget(fnm)) expect_equal(fn(), 1) expect_equal(fn(), 2) expect_equal(fnm(), 3) expect_equal(fnm(), 3) expect_equal(fn(), 4) expect_equal(fnm(), 3) expect_false(forget(fn)) expect_true(forget(fnm)) expect_equal(fnm(), 5) expect_true(drop_cache(fnm)()) expect_equal(fnm(), 6) expect_true(is.memoised(fnm)) expect_false(is.memoised(fn)) }) test_that("two functions with the same arguments produce different caches (#38)", { temp <- tempfile() fs <- cache_filesystem(temp) f1 <- memoise(function() 1, cache = fs) f2 <- memoise(function() 2, cache = fs) expect_equal(f1(), 1) expect_equal(f2(), 2) expect_equal(length(list.files(temp)), 2) }) memoise/tests/testthat.R0000644000175000017500000000007212616234453015174 0ustar nileshnileshlibrary(testthat) library(memoise) test_check("memoise") memoise/R/0000755000175000017500000000000014147526642012256 5ustar nileshnileshmemoise/R/memoise.R0000644000175000017500000002723314147524623014043 0ustar nileshnilesh#' Memoise a function #' #' \code{mf <- memoise(f)} creates \code{mf}, a memoised copy of #' \code{f}. A memoised copy is basically a #' lazier version of the same function: it saves the answers of #' new invocations, and re-uses the answers of old ones. Under the right #' circumstances, this can provide a very nice speedup indeed. #' #' There are two main ways to use the \code{memoise} function. Say that #' you wish to memoise \code{glm}, which is in the \code{stats} #' package; then you could use \cr #' \code{ mem_glm <- memoise(glm)}, or you could use\cr #' \code{ glm <- memoise(stats::glm)}. \cr #' The first form has the advantage that you still have easy access to #' both the memoised and the original function. The latter is especially #' useful to bring the benefits of memoisation to an existing block #' of R code. #' #' Two example situations where \code{memoise} could be of use: #' \itemize{ #' \item You're evaluating a function repeatedly over the rows (or #' larger chunks) of a dataset, and expect to regularly get the same #' input. #' \item You're debugging or developing something, which involves #' a lot of re-running the code. If there are a few expensive calls #' in there, memoising them can make life a lot more pleasant. #' If the code is in a script file that you're \code{source()}ing, #' take care that you don't just put \cr #' \code{ glm <- memoise(stats::glm)} \cr #' at the top of your file: that would reinitialise the memoised #' function every time the file was sourced. Wrap it in \cr #' \code{ if (!is.memoised(glm)) }, or do the memoisation call #' once at the R prompt, or put it somewhere else where it won't get #' repeated. #' } #' #' It is recommended that functions in a package are not memoised at build-time, #' but when the package is loaded. The simplest way to do this is within #' \code{.onLoad()} with, for example #' #' #' \preformatted{ #' # file.R #' fun <- function() { #' some_expensive_process() #' } #' #' # zzz.R #' .onLoad <- function(libname, pkgname) { #' fun <<- memoise::memoise(fun) #' } #' } #' @name memoise #' @param f Function of which to create a memoised copy. #' @param ... optional variables to use as additional restrictions on #' caching, specified as one-sided formulas (no LHS). See Examples for usage. #' @param envir Environment of the returned function. #' @param cache Cache object. The default is a [cachem::cache_mem()] with a max #' size of 1024 MB. #' @param hash A function which takes an R object as input and returns a string #' which is used as a cache key. #' @param omit_args Names of arguments to ignore when calculating hash. #' @seealso \code{\link{forget}}, \code{\link{is.memoised}}, #' \code{\link{timeout}}, \url{https://en.wikipedia.org/wiki/Memoization}, #' \code{\link{drop_cache}} #' @aliases memoise memoize #' @export memoise memoize #' @examples #' # a() is evaluated anew each time. memA() is only re-evaluated #' # when you call it with a new set of parameters. #' a <- function(n) { runif(n) } #' memA <- memoise(a) #' replicate(5, a(2)) #' replicate(5, memA(2)) #' #' # Caching is done based on parameters' value, so same-name-but- #' # changed-value correctly produces two different outcomes... #' N <- 4; memA(N) #' N <- 5; memA(N) #' # ... and same-value-but-different-name correctly produces #' # the same cached outcome. #' N <- 4; memA(N) #' N2 <- 4; memA(N2) #' #' # memoise() knows about default parameters. #' b <- function(n, dummy="a") { runif(n) } #' memB <- memoise(b) #' memB(2) #' memB(2, dummy="a") #' # This works, because the interface of the memoised function is the same as #' # that of the original function. #' formals(b) #' formals(memB) #' # However, it doesn't know about parameter relevance. #' # Different call means different caching, no matter #' # that the outcome is the same. #' memB(2, dummy="b") #' #' # You can create multiple memoisations of the same function, #' # and they'll be independent. #' memA(2) #' memA2 <- memoise(a) #' memA(2) # Still the same outcome #' memA2(2) # Different cache, different outcome #' #' # Multiple memoized functions can share a cache. #' cm <- cachem::cache_mem(max_size = 50 * 1024^2) #' memA <- memoise(a, cache = cm) #' memB <- memoise(b, cache = cm) #' #' # Don't do the same memoisation assignment twice: a brand-new #' # memoised function also means a brand-new cache, and *that* #' # you could as easily and more legibly achieve using forget(). #' # (If you're not sure whether you already memoised something, #' # use is.memoised() to check.) #' memA(2) #' memA <- memoise(a) #' memA(2) #' #' # Make a memoized result automatically time out after 10 seconds. #' memA3 <- memoise(a, cache = cachem::cache_mem(max_age = 10)) #' memA3(2) #' @importFrom stats setNames memoise <- memoize <- function( f, ..., envir = environment(f), cache = cachem::cache_mem(max_size = 1024 * 1024^2), omit_args = c(), hash = function(x) rlang::hash(x)) { f_formals <- formals(args(f)) if(is.memoised(f)) { stop("`f` must not be memoised.", call. = FALSE) } validate_formulas(...) additional <- list(...) memo_f <- function(...) { mc <- match.call() encl <- parent.env(environment()) called_args <- as.list(mc)[-1] # Formals with a default default_args <- encl$`_default_args` # That has not been called default_args <- default_args[setdiff(names(default_args), names(called_args))] # Ignored specified arguments when hashing called_args[encl$`_omit_args`] <- NULL # Evaluate all the arguments args <- c(lapply(called_args, eval, parent.frame()), lapply(default_args, eval, envir = environment())) key <- encl$`_hash`( c( encl$`_f_hash`, args, lapply(encl$`_additional`, function(x) eval(x[[2L]], environment(x))) ) ) res <- encl$`_cache`$get(key) if (inherits(res, "key_missing")) { # modify the call to use the original function and evaluate it mc[[1L]] <- encl$`_f` res <- withVisible(eval(mc, parent.frame())) encl$`_cache`$set(key, res) } if (res$visible) { res$value } else { invisible(res$value) } } formals(memo_f) <- f_formals attr(memo_f, "memoised") <- TRUE # This should only happen for primitive functions if (is.null(envir)) { envir <- baseenv() } # Handle old-style memoise cache objects if (is_old_cache(cache)) { # Old-style caches include their own digest algorithm, so use that instead # of whatever is passed in. hash <- cache$digest cache <- wrap_old_cache(cache) } memo_f_env <- new.env(parent = envir) memo_f_env$`_hash` <- hash memo_f_env$`_cache` <- cache memo_f_env$`_f` <- f # Precompute hash of function. This saves work because when this is added to # the list of objects to hash, it doesn't need to serialize and hash the # entire function. This does not include the environment or source refs. # The as.character() is there to ensure source refs are not included. memo_f_env$`_f_hash` <- rlang::hash(list(formals(f), as.character(body(f)))) memo_f_env$`_additional` <- additional memo_f_env$`_omit_args` <- omit_args # Formals with a default value memo_f_env$`_default_args` <- Filter(function(x) !identical(x, quote(expr = )), f_formals) environment(memo_f) <- memo_f_env class(memo_f) <- c("memoised", "function") memo_f } #' Return a new number after a given number of seconds #' #' This function will return a number corresponding to the system time and #' remain stable until a given number of seconds have elapsed, after which it #' will update to the current time. This makes it useful as a way to timeout #' and invalidate a memoised cache after a certain period of time. #' @param seconds Number of seconds after which to timeout. #' @param current The current time as a numeric. #' @return A numeric that will remain constant until the seconds have elapsed. #' @seealso \code{\link{memoise}} #' @export #' @examples #' a <- function(n) { runif(n) } #' memA <- memoise(a, ~timeout(10)) #' memA(2) timeout <- function(seconds, current = as.numeric(Sys.time())) { (current - current %% seconds) %/% seconds } validate_formulas <- function(...) { format.name <- function(x, ...) format(as.character(x), ...) is_formula <- function(x) { if (is.call(x) && identical(x[[1]], as.name("~"))) { if (length(x) > 2L) { stop("`x` must be a one sided formula [not ", format(x), "].", call. = FALSE) } } else { stop("`", format(x), "` must be a formula.", call. = FALSE) } } dots <- eval(substitute(alist(...))) lapply(dots, is_formula) } #' @export print.memoised <- function(x, ...) { cat("Memoised Function:\n") tryCatch(print(environment(x)$`_f`), error = function(e) stop("No function defined!", call. = FALSE)) } #' Forget past results. #' Resets the cache of a memoised function. Use \code{\link{drop_cache}} to #' reset the cache only for particular arguments. #' #' @param f memoised function #' @export #' @seealso \code{\link{memoise}}, \code{\link{is.memoised}}, \code{\link{drop_cache}} #' @examples #' memX <- memoise(function() { Sys.sleep(1); runif(1) }) #' # The forget() function #' system.time(print(memX())) #' system.time(print(memX())) #' forget(memX) #' system.time(print(memX())) forget <- function(f) { if (!is.memoised(f)) { return(FALSE) } env <- environment(f) if (!exists("_cache", env, inherits = FALSE)) return(FALSE) # nocovr cache <- get("_cache", env) cache$reset() TRUE } #' Test whether a function is a memoised copy. #' Memoised copies of functions carry an attribute #' \code{memoised = TRUE}, which is what \code{is.memoised()} tests for. #' @param f Function to test. #' @seealso \code{\link{memoise}}, \code{\link{forget}} #' @export is.memoised is.memoized #' @aliases is.memoised is.memoized #' @examples #' mem_lm <- memoise(lm) #' is.memoised(lm) # FALSE #' is.memoised(mem_lm) # TRUE is.memoised <- is.memoized <- function(f) { is.function(f) && inherits(f, "memoised") } #' Test whether a memoised function has been cached for particular arguments. #' @param f Function to test. #' @return A function, with the same arguments as \code{f}, that can be called to test #' if \code{f} has cached results. #' @seealso \code{\link{is.memoised}}, \code{\link{memoise}}, \code{\link{drop_cache}} #' @export #' @examples #' mem_sum <- memoise(sum) #' has_cache(mem_sum)(1, 2, 3) # FALSE #' mem_sum(1, 2, 3) #' has_cache(mem_sum)(1, 2, 3) # TRUE has_cache <- function(f) { if(!is.memoised(f)) stop("`f` is not a memoised function!", call. = FALSE) # Modify the function body of the function to simply return TRUE and FALSE # rather than get or set the results of the cache body <- body(f) body[[10]] <- quote(return(encl$`_cache`$exists(key))) body(f) <- body f } #' Drops the cache of a memoised function for particular arguments. #' @param f Memoised function. #' @return A function, with the same arguments as \code{f}, that can be called to drop #' the cached results of \code{f}. #' @seealso \code{\link{has_cache}}, \code{\link{memoise}} #' @export #' @examples #' mem_sum <- memoise(sum) #' mem_sum(1, 2, 3) #' mem_sum(2, 3, 4) #' has_cache(mem_sum)(1, 2, 3) # TRUE #' has_cache(mem_sum)(2, 3, 4) # TRUE #' drop_cache(mem_sum)(1, 2, 3) # TRUE #' has_cache(mem_sum)(1, 2, 3) # FALSE #' has_cache(mem_sum)(2, 3, 4) # TRUE drop_cache <- function(f) { if(!is.memoised(f)) stop("`f` is not a memoised function!", call. = FALSE) # Modify the function body of the function to simply drop the key # and return TRUE if successfully removed body <- body(f) body[[10]] <- quote(if (encl$`_cache`$exists(key)) { encl$`_cache`$remove(key) return(TRUE) } else { return(FALSE) }) body(f) <- body f } memoise/R/cache_memory.R0000644000175000017500000000204514147524623015032 0ustar nileshnilesh#' In Memory Cache #' #' A cache in memory, that lasts only in the current R session. #' @param algo The hashing algorithm used for the cache, see #' \code{\link[digest]{digest}} for available algorithms. #' @export cache_memory <- function(algo = "sha512") { if (!(requireNamespace("digest"))) { stop("Package `digest` must be installed for `cache_memory()`.") } # nocov cache <- NULL cache_reset <- function() { cache <<- new.env(TRUE, emptyenv()) } cache_set <- function(key, value) { assign(key, value, envir = cache) } cache_get <- function(key) { get(key, envir = cache, inherits = FALSE) } cache_has_key <- function(key) { exists(key, envir = cache, inherits = FALSE) } cache_drop_key <- function(key) { rm(list = key, envir = cache, inherits = FALSE) } cache_reset() list( digest = function(...) digest::digest(..., algo = algo), reset = cache_reset, set = cache_set, get = cache_get, has_key = cache_has_key, drop_key = cache_drop_key, keys = function() ls(cache) ) } memoise/R/old_cache.R0000644000175000017500000000127314147524623014302 0ustar nileshnilesh# Wrap an old-style cache so that the external API is consistent with that from # the cache package. #' @importFrom cachem key_missing wrap_old_cache <- function(x) { if (!is_old_cache(x)) { stop("`x` must be an old-style cache.", call. = FALSE) } list( digest = x$digest, reset = x$reset, set = x$set, get = function(key) { if (!x$has_key(key)) { return(key_missing()) } x$get(key) }, exists = x$has_key, remove = x$drop_key, keys = x$keys ) } # Returns TRUE if it's an old-style cache. is_old_cache <- function(x) { is.function(x$digest) && is.function(x$set) && is.function(x$get) && is.function(x$has_key) } memoise/R/cache_gcs.R0000644000175000017500000000503014147524623014273 0ustar nileshnilesh#' Google Cloud Storage Cache #' Google Cloud Storage backed cache, for remote caching. #' #' @examples #' #' \dontrun{ #' library(googleCloudStorageR) #' # Set GCS credentials. #' Sys.setenv("GCS_AUTH_FILE"="", #' "GCS_DEFAULT_BUCKET"="unique-bucket-name") #' #' gcs <- cache_gcs("unique-bucket-name") #' mem_runif <- memoise(runif, cache = gcs) #' } #' #' #' @param cache_name Bucket name for storing cache files. #' @param compress Argument passed to \code{saveRDS}. One of FALSE, "gzip", #' "bzip2" or "xz". Default: FALSE. #' @inheritParams cache_memory #' @export cache_gcs <- function(cache_name = googleCloudStorageR::gcs_get_global_bucket(), algo = "sha512", compress = FALSE) { if (!(requireNamespace("digest"))) { stop("Package `digest` must be installed for `cache_gcs()`.") } # nocov if (!(requireNamespace("googleCloudStorageR"))) { stop("Package `googleCloudStorageR` must be installed for `cache_gcs()`.") } # nocov path <- tempfile("memoise-") dir.create(path) cache_reset <- function() { keys <- cache_keys() lapply(keys, googleCloudStorageR::gcs_delete_object, bucket = cache_name) } cache_set <- function(key, value) { temp_file <- file.path(path, key) on.exit(unlink(temp_file)) saveRDS(value, file = temp_file, compress = compress) suppressMessages( googleCloudStorageR::gcs_upload(temp_file, name = key, bucket = cache_name) ) } cache_get <- function(key) { temp_file <- file.path(path, key) suppressMessages( googleCloudStorageR::gcs_get_object(key, bucket = cache_name, saveToDisk = temp_file, overwrite = TRUE) ) readRDS(temp_file) } cache_has_key <- function(key) { objs <- suppressMessages( googleCloudStorageR::gcs_list_objects(prefix = key, bucket = cache_name) ) is_here <- objs$name == key # if not result is logical(0) if(identical(is_here, logical(0))){ is_here <- FALSE } is_here } cache_drop_key <- function(key) { googleCloudStorageR::gcs_delete_object(key, bucket = cache_name) } cache_keys <- function() { items <- googleCloudStorageR::gcs_list_objects(bucket = cache_name) items$name } list( digest = function(...) digest::digest(..., algo = algo), reset = cache_reset, set = cache_set, get = cache_get, has_key = cache_has_key, drop_key = cache_drop_key, keys = cache_keys ) } memoise/R/cache_s3.R0000644000175000017500000000427414147524623014055 0ustar nileshnilesh#' Amazon Web Services S3 Cache #' Amazon Web Services S3 backed cache, for remote caching. #' #' @examples #' #' \dontrun{ #' # Set AWS credentials. #' Sys.setenv("AWS_ACCESS_KEY_ID" = "", #' "AWS_SECRET_ACCESS_KEY" = "") #' #' # Set up a unique bucket name. #' s3 <- cache_s3("unique-bucket-name") #' mem_runif <- memoise(runif, cache = s3) #' } #' #' #' @param cache_name Bucket name for storing cache files. #' @param compress Argument passed to \code{saveRDS}. One of FALSE, "gzip", #' "bzip2" or "xz". Default: FALSE. #' @inheritParams cache_memory #' @export cache_s3 <- function(cache_name, algo = "sha512", compress = FALSE) { if (!(requireNamespace("digest"))) { stop("Package `digest` must be installed for `cache_s3()`.") } # nocov if (!(requireNamespace("aws.s3"))) { stop("Package `aws.s3` must be installed for `cache_s3()`.") } # nocov if (!(aws.s3::bucket_exists(cache_name))) { aws.s3::put_bucket(cache_name) # nocov } path <- tempfile("memoise-") dir.create(path) cache_reset <- function() { keys <- cache_keys() lapply(keys, aws.s3::delete_bucket, bucket = cache_name) } cache_set <- function(key, value) { temp_file <- file.path(path, key) on.exit(unlink(temp_file)) saveRDS(value, file = temp_file, compress = compress) aws.s3::put_object(temp_file, object = key, bucket = cache_name) } cache_get <- function(key) { temp_file <- file.path(path, key) httr::with_config(httr::write_disk(temp_file, overwrite = TRUE), { aws.s3::get_object(object = key, bucket = cache_name) }) readRDS(temp_file) } cache_has_key <- function(key) { suppressMessages(aws.s3::head_object(object = key, bucket = cache_name)) } cache_drop_key <- function(key) { aws.s3::delete_bucket(key, bucket = cache_name) } cache_keys <- function() { items <- lapply(aws.s3::get_bucket(bucket = cache_name), `[[`, "Key") as.character(unlist(Filter(Negate(is.null), items))) } list( digest = function(...) digest::digest(..., algo = algo), reset = cache_reset, set = cache_set, get = cache_get, has_key = cache_has_key, drop_key = cache_drop_key, keys = cache_keys ) } memoise/R/cache_filesystem.R0000644000175000017500000000323414147524623015707 0ustar nileshnilesh#' Filesystem Cache #' #' Use a cache on the local filesystem that will persist between R sessions. #' #' @param path Directory in which to store cached items. #' @param compress Argument passed to \code{saveRDS}. One of FALSE, "gzip", #' "bzip2" or "xz". Default: FALSE. #' #' @examples #' #' \dontrun{ #' # Use with Dropbox #' #' db <- cache_filesystem("~/Dropbox/.rcache") #' #' mem_runif <- memoise(runif, cache = db) #' #' # Use with Google Drive #' #' gd <- cache_filesystem("~/Google Drive/.rcache") #' #' mem_runif <- memoise(runif, cache = gd) #' #' } #' #' @export #' @inheritParams cache_memory cache_filesystem <- function(path, algo = "xxhash64", compress = FALSE) { if (!(requireNamespace("digest"))) { stop("Package `digest` must be installed for `cache_filesystem()`.") } # nocov if (!dir.exists(path)) { dir.create(path, showWarnings = FALSE) } # convert to absolute path so it will work with user working directory changes path <- normalizePath(path) cache_reset <- function() { cache_files <- list.files(path, full.names = TRUE) file.remove(cache_files) } cache_set <- function(key, value) { saveRDS(value, file = file.path(path, key), compress = compress) } cache_get <- function(key) { readRDS(file = file.path(path, key)) } cache_has_key <- function(key) { file.exists(file.path(path, key)) } cache_drop_key <- function(key) { file.remove(file.path(path, key)) } list( digest = function(...) digest::digest(..., algo = algo), reset = cache_reset, set = cache_set, get = cache_get, has_key = cache_has_key, drop_key = cache_drop_key, keys = function() list.files(path) ) } memoise/LICENSE0000644000175000017500000000006114147523405013051 0ustar nileshnileshYEAR: 2010-2017 COPYRIGHT HOLDER: Hadley Wickham memoise/NAMESPACE0000644000175000017500000000053614147526244013276 0ustar nileshnilesh# Generated by roxygen2: do not edit by hand S3method(print,memoised) export(cache_filesystem) export(cache_gcs) export(cache_memory) export(cache_s3) export(drop_cache) export(forget) export(has_cache) export(is.memoised) export(is.memoized) export(memoise) export(memoize) export(timeout) importFrom(cachem,key_missing) importFrom(stats,setNames)