[med-svn] [r-cran-memoise] 11/15: New upstream version 1.0.0
Andreas Tille
tille at debian.org
Fri Sep 29 19:56:28 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-memoise.
commit 5b2be2492ede68956392b6a12fd6d3daf15af7e8
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 29 21:49:01 2017 +0200
New upstream version 1.0.0
---
DESCRIPTION | 24 ++++
LICENSE | 2 +
MD5 | 14 +++
NAMESPACE | 12 ++
NEWS.md | 32 +++++
R/cache.r | 28 +++++
R/memoise.r | 270 ++++++++++++++++++++++++++++++++++++++++++
README.md | 21 ++++
debian/README.test | 8 --
debian/changelog | 36 ------
debian/compat | 1 -
debian/control | 23 ----
debian/copyright | 44 -------
debian/docs | 3 -
debian/rules | 8 --
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 13 --
debian/watch | 2 -
man/forget.Rd | 28 +++++
man/has_cache.Rd | 26 ++++
man/is.memoised.Rd | 28 +++++
man/memoise.Rd | 112 ++++++++++++++++++
man/timeout.Rd | 31 +++++
tests/testthat.R | 4 +
tests/testthat/test-memoise.R | 260 ++++++++++++++++++++++++++++++++++++++++
26 files changed, 892 insertions(+), 142 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..893105c
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,24 @@
+Encoding: UTF-8
+Package: memoise
+Title: Memoisation of Functions
+Version: 1.0.0
+Authors at R: c(
+ person("Hadley", "Wickham", , "hadley at rstudio.com", role = "aut"),
+ person("Jim", "Hester", , "jim.hester at rstudio.com", role = c("aut", "cre")),
+ person("Kirill", "Müller", , "krlmlr+r at mailbox.org", role = "aut"))
+Description: Cache the results of a function so that when you call it
+ again with the same arguments it returns the pre-computed value.
+URL: https://github.com/hadley/memoise
+BugReports: https://github.com/hadley/memoise/issues
+Imports: digest (>= 0.6.3)
+Suggests: testthat
+License: MIT + file LICENSE
+RoxygenNote: 5.0.1
+NeedsCompilation: no
+Packaged: 2016-01-28 19:30:15 UTC; jhester
+Author: Hadley Wickham [aut],
+ Jim Hester [aut, cre],
+ Kirill Müller [aut]
+Maintainer: Jim Hester <jim.hester at rstudio.com>
+Repository: CRAN
+Date/Publication: 2016-01-29 05:58:01
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..267ea46
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2010-2016
+COPYRIGHT HOLDER: Hadley Wickham
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..701f020
--- /dev/null
+++ b/MD5
@@ -0,0 +1,14 @@
+b207f226950a7040e1c319f2faa62694 *DESCRIPTION
+5a2ffc012eac074809a07ea440f872a8 *LICENSE
+29ff4bc0eaf941a3184340888a3adfce *NAMESPACE
+46d7d31fbc75bc3b4484b8ab0b5c4b22 *NEWS.md
+65efb37c5ec0b0aef53eba56fdbbb49f *R/cache.r
+06c37351cb0331bc22da278d43ff72a2 *R/memoise.r
+0be5258a057bcfe22b8fc5cb3b004b9c *README.md
+903db28a663ac1ba554e9b1fc2b9d364 *man/forget.Rd
+866463e90847d285f3a6d6cf736a61ca *man/has_cache.Rd
+ad48c04294167c927c44fe272047c7cf *man/is.memoised.Rd
+18ce3fffab957386abc962f6816144ec *man/memoise.Rd
+8e261440b9a586b0640437382d4d35df *man/timeout.Rd
+c4111f4662e1dada1a4d23df123018f9 *tests/testthat.R
+76a18f20ca3d39b0d82c7f84598f9d53 *tests/testthat/test-memoise.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..0bf84c1
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,12 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(print,memoised)
+export(forget)
+export(has_cache)
+export(is.memoised)
+export(is.memoized)
+export(memoise)
+export(memoize)
+export(timeout)
+importFrom(digest,digest)
+importFrom(stats,setNames)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..43a6786
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,32 @@
+# 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.
diff --git a/R/cache.r b/R/cache.r
new file mode 100644
index 0000000..23d542f
--- /dev/null
+++ b/R/cache.r
@@ -0,0 +1,28 @@
+new_cache <- function() {
+
+ 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_reset()
+ list(
+ reset = cache_reset,
+ set = cache_set,
+ get = cache_get,
+ has_key = cache_has_key,
+ keys = function() ls(cache)
+ )
+}
diff --git a/R/memoise.r b/R/memoise.r
new file mode 100644
index 0000000..ac0ae73
--- /dev/null
+++ b/R/memoise.r
@@ -0,0 +1,270 @@
+#' \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.
+#' }
+#'
+#' @name memoise
+#' @title Memoise a function.
+#' @param f Function of which to create a memoised copy.
+#' @param ... optional variables specified as formulas with no RHS to use as
+#' additional restrictions on caching. See Examples for usage.
+#' @param envir Environment of the returned function.
+#' @seealso \code{\link{forget}}, \code{\link{is.memoised}},
+#' \code{\link{timeout}}, \url{http://en.wikipedia.org/wiki/Memoization}
+#' @aliases memoise memoize
+#' @export memoise memoize
+#' @importFrom digest digest
+#' @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 cacheing, 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
+#'
+#' # 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)
+#' # Making a memoized automatically time out after 10 seconds.
+#' memA3 <- memoise(a, ~{current <- as.numeric(Sys.time()); (current - current %% 10) %/% 10 })
+#' memA3(2)
+#'
+#' # The timeout function is any easy way to do the above.
+#' memA4 <- memoise(a, ~timeout(10))
+#' memA4(2)
+#' @importFrom stats setNames
+memoise <- memoize <- function(f, ..., envir = environment(f)) {
+ f_formals <- formals(args(f))
+ if(is.memoised(f)) {
+ stop("`f` must not be memoised.", call. = FALSE)
+ }
+
+ f_formal_names <- names(f_formals)
+ f_formal_name_list <- lapply(f_formal_names, as.name)
+
+ # list(...)
+ list_call <- make_call(quote(list), f_formal_name_list)
+
+ # memoised_function(...)
+ init_call_args <- setNames(f_formal_name_list, f_formal_names)
+ init_call <- make_call(quote(`_f`), init_call_args)
+
+ cache <- new_cache()
+
+ validate_formulas(...)
+ additional <- list(...)
+
+ memo_f <- eval(
+ bquote(function(...) {
+ hash <- `_digest`(c(.(list_call),
+ lapply(`_additional`, function(x) eval(x[[2L]], environment(x)))),
+ algo = "sha512")
+
+ if (`_cache`$has_key(hash)) {
+ res <- `_cache`$get(hash)
+ } else {
+ res <- withVisible(.(init_call))
+ `_cache`$set(hash, res)
+ }
+
+ if (res$visible) {
+ res$value
+ } else {
+ invisible(res$value)
+ }
+ },
+ as.environment(list(list_call = list_call, init_call = init_call)))
+ )
+ formals(memo_f) <- f_formals
+ attr(memo_f, "memoised") <- TRUE
+
+ # This should only happen for primitive functions
+ if (is.null(envir)) {
+ envir <- baseenv()
+ }
+
+ memo_f_env <- new.env(parent = envir)
+ memo_f_env$`_cache` <- cache
+ memo_f_env$`_f` <- f
+ memo_f_env$`_digest` <- digest
+ memo_f_env$`_additional` <- additional
+ environment(memo_f) <- memo_f_env
+
+ class(memo_f) <- c("memoised", "function")
+
+ memo_f
+}
+
+make_call <- function(name, args) {
+ stopifnot(is.name(name), is.list(args))
+ as.call(c(list(name), args))
+}
+
+#' 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.
+#'
+#' @param f memoised function
+#' @export
+#' @seealso \code{\link{memoise}}, \code{\link{is.memoised}}
+#' @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)
+
+ 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.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.
+#' @param ... arguments to function.
+#' @seealso \code{\link{is.memoised}}, \code{\link{memoise}}
+#' @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[[3]] <- quote(if (`_cache`$has_key(hash)) return(TRUE) else return(FALSE))
+ body(f) <- body
+
+ f
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..f2b4566
--- /dev/null
+++ b/README.md
@@ -0,0 +1,21 @@
+# memoise [](https://travis-ci.org/hadley/memoise) [](https://codecov.io/github/hadley/memoise?branch=master)
+
+
+If a function is called multiple times with the same input, you can
+often speed things up by keeping a cache of known answers that it can
+retrieve. This is called memoisation <http://en.wikipedia.org/wiki/Memoization>.
+The `memoise` package provides a simple syntax
+
+ mf <- memoise(f)
+
+to create `mf()`, a memoised wrapper around `f()`. You can clear `mf`'s
+cache with
+
+ forget(mf)
+
+, and you can test whether a function is memoised with
+
+ is.memoised(mf) # TRUE
+ is.memoised(f) # FALSE
+
+.
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 90657cf..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
- sh run-unit-test
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 35ef3b1..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,36 +0,0 @@
-r-cran-memoise (1.0.0-1) unstable; urgency=medium
-
- * New upstream version
- * Rename source package to the usual naming pattern
- * cme fix dpkg-control
- * Convert to dh-r
- * Canonical homepage for CRAN
- * Update copyright
- * Drop Ivo Maintz from Uploaders
- * debhelper 10
- * d/watch: version=4
- * Add autopkgtest
-
- -- Andreas Tille <tille at debian.org> Wed, 30 Nov 2016 10:24:09 +0100
-
-memoise (0.2.1-1) unstable; urgency=medium
-
- * New upstream version
- * Remove extra license file
-
- -- Andreas Tille <tille at debian.org> Tue, 01 Jul 2014 17:33:19 +0200
-
-memoise (0.1-2) unstable; urgency=low
-
- * Add README.test
- * rebuild with recent R
- Closes: #730747
- * canonical Vcs URLs
-
- -- Andreas Tille <tille at debian.org> Fri, 29 Nov 2013 10:51:00 +0100
-
-memoise (0.1-1) unstable; urgency=low
-
- * Initial release (Closes: #701568)
-
- -- Ivo Maintz <ivo at maintz.de> Sun, 24 Feb 2013 16:42:10 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index f599e28..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-10
diff --git a/debian/control b/debian/control
deleted file mode 100644
index cd6783d..0000000
--- a/debian/control
+++ /dev/null
@@ -1,23 +0,0 @@
-Source: r-cran-memoise
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 10),
- r-base-dev,
- r-cran-digest,
- dh-r
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-memoise/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-memoise/trunk/
-Homepage: https://cran.r-project.org/package=memoise
-
-Package: r-cran-memoise
-Architecture: all
-Depends: ${R:Depends},
- ${misc:Depends}
-Recommends: ${R:Recommends}
-Suggests: ${R:Suggests}
-Description: Memoise functions
- Cache the results of a function so that when you call it again with the same
- arguments it returns the pre-computed value.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 6b684fc..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,44 +0,0 @@
-Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Jim Hester <jim.hester at rstudio.com>
-Upstream-Name: memoise
-Source: https://cran.r-project.org/package=memoise
-
-Files: *
-Copyright: 2012-2016 Hadley Wickham <h.wickham at gmail.com>
- Jim Hester, Kirill Müller
-License: MIT
- Permission is hereby granted, free of charge, to any person obtaining a copy
- of this software and associated documentation files (the "Software"), to deal
- in the Software without restriction, including without limitation the rights
- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
- of the Software, and to permit persons to whom the Software is furnished to do
- so, subject to the following conditions:
- .
- The above copyright notice and this permission notice shall be included in all
- copies or substantial portions of the Software.
- .
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
-Files: debian/*
-Copyright: 2012 Ivo Maintz <ivo at maintz.de>
-License: GPL-2+
- This package is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This package is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>
- .
- On Debian systems, the complete text of the GNU General
- Public License version 2 can be found in "/usr/share/common-licenses/GPL-2".
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 7106257..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/usr/bin/make -f
-
-%:
- dh $@ --buildsystem R
-
-override_dh_install:
- dh_install
- find . -name LICENSE -delete
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 982bc8c..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,13 +0,0 @@
-#!/bin/sh -e
-
-oname=memoise
-pkg=r-cran-`echo $oname | tr '[A-Z]' '[a-z]'`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
- trap "rm -rf $ADTTMP" 0 INT QUIT ABRT PIPE TERM
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-find . -name "*.gz" -exec gunzip \{\} \;
-LC_ALL=C R --no-save < testthat.R
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 88cd84c..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,2 +0,0 @@
-version=4
-http://cran.r-project.org/src/contrib/memoise_([\d.-]*)\.tar.gz
diff --git a/man/forget.Rd b/man/forget.Rd
new file mode 100644
index 0000000..633e40a
--- /dev/null
+++ b/man/forget.Rd
@@ -0,0 +1,28 @@
+% 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.}
+\usage{
+forget(f)
+}
+\arguments{
+\item{f}{memoised function}
+}
+\description{
+Forget past results.
+Resets the cache of a memoised function.
+}
+\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}}
+}
+
diff --git a/man/has_cache.Rd b/man/has_cache.Rd
new file mode 100644
index 0000000..69f4ad7
--- /dev/null
+++ b/man/has_cache.Rd
@@ -0,0 +1,26 @@
+% 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.}
+
+\item{...}{arguments to function.}
+}
+\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}}
+}
+
diff --git a/man/is.memoised.Rd b/man/is.memoised.Rd
new file mode 100644
index 0000000..cfac4d2
--- /dev/null
+++ b/man/is.memoised.Rd
@@ -0,0 +1,28 @@
+% 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.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.memoised() tests for.
+}
+\examples{
+mem_lm <- memoise(lm)
+is.memoised(lm) # FALSE
+is.memoised(mem_lm) # TRUE
+}
+\seealso{
+\code{\link{memoise}}, \code{\link{forget}}
+}
+
diff --git a/man/memoise.Rd b/man/memoise.Rd
new file mode 100644
index 0000000..c3ba39a
--- /dev/null
+++ b/man/memoise.Rd
@@ -0,0 +1,112 @@
+% 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))
+}
+\arguments{
+\item{f}{Function of which to create a memoised copy.}
+
+\item{...}{optional variables specified as formulas with no RHS to use as
+additional restrictions on caching. See Examples for usage.}
+
+\item{envir}{Environment of the returned function.}
+}
+\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.
+}
+}
+\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 cacheing, 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
+
+# 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)
+# Making a memoized automatically time out after 10 seconds.
+memA3 <- memoise(a, ~{current <- as.numeric(Sys.time()); (current - current \%\% 10) \%/\% 10 })
+memA3(2)
+
+# The timeout function is any easy way to do the above.
+memA4 <- memoise(a, ~timeout(10))
+memA4(2)
+}
+\seealso{
+\code{\link{forget}}, \code{\link{is.memoised}},
+ \code{\link{timeout}}, \url{http://en.wikipedia.org/wiki/Memoization}
+}
+
diff --git a/man/timeout.Rd b/man/timeout.Rd
new file mode 100644
index 0000000..588d3d0
--- /dev/null
+++ b/man/timeout.Rd
@@ -0,0 +1,31 @@
+% 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}}
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..922f27c
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(memoise)
+
+test_check("memoise")
diff --git a/tests/testthat/test-memoise.R b/tests/testthat/test-memoise.R
new file mode 100644
index 0000000..7eb9138
--- /dev/null
+++ b/tests/testthat/test-memoise.R
@@ -0,0 +1,260 @@
+context("memoise")
+
+test_that("memoisation works", {
+ fn <- function() { i <<- i + 1; i }
+ i <- 0
+
+ expect_that(fnm <- memoise(fn), not(gives_warning()))
+ 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(is.memoised(fnm))
+ expect_false(is.memoised(fn))
+})
+
+test_that("memoisation depends on argument", {
+ fn <- function(j) { i <<- i + 1; i }
+ i <- 0
+
+ expect_that(fnm <- memoise(fn), not(gives_warning()))
+ 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_that(fnm <- memoise(fn), not(gives_warning()))
+ 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(), 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_that(fnm <- memoise(fn), not(gives_warning()))
+ 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_that(fnm <- memoise(fn), not(gives_warning()))
+ 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("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_that(fm <- memoise(function(a = 1) a), not(gives_warning()))
+ 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_that(fm <- memoise(`+`), not(gives_warning()))
+ 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))
+})
+
+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("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_that(first, not(equals(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_that(first, not(equals(timeout(duration, 100))))
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-memoise.git
More information about the debian-med-commit
mailing list