1context("memoise") 2 3test_that("memoisation works", { 4 fn <- function() { i <<- i + 1; i } 5 i <- 0 6 7 expect_warning(fnm <- memoise(fn), NA) 8 expect_equal(fn(), 1) 9 expect_equal(fn(), 2) 10 expect_equal(fnm(), 3) 11 expect_equal(fnm(), 3) 12 expect_equal(fn(), 4) 13 expect_equal(fnm(), 3) 14 15 expect_false(forget(fn)) 16 expect_true(forget(fnm)) 17 expect_true(forget(fnm)) 18 expect_equal(fnm(), 5) 19 20 expect_true(is.memoised(fnm)) 21 expect_false(is.memoised(fn)) 22}) 23 24test_that("memoisation depends on argument", { 25 fn <- function(j) { i <<- i + 1; i } 26 i <- 0 27 28 expect_warning(fnm <- memoise(fn), NA) 29 expect_equal(fn(1), 1) 30 expect_equal(fn(1), 2) 31 expect_equal(fnm(1), 3) 32 expect_equal(fnm(1), 3) 33 expect_equal(fn(1), 4) 34 expect_equal(fnm(1), 3) 35 expect_equal(fnm(2), 5) 36 expect_equal(fnm(2), 5) 37 expect_equal(fnm(1), 3) 38 expect_equal(fn(2), 6) 39}) 40 41test_that("interface of wrapper matches interface of memoised function", { 42 fn <- function(j) { i <<- i + 1; i } 43 i <- 0 44 45 expect_equal(formals(fn), formals(memoise(fn))) 46 expect_equal(formals(runif), formals(memoise(runif))) 47 expect_equal(formals(paste), formals(memoise(paste))) 48}) 49 50test_that("dot arguments are used for hash", { 51 fn <- function(...) { i <<- i + 1; i } 52 i <- 0 53 54 expect_warning(fnm <- memoise(fn), NA) 55 expect_equal(fn(1), 1) 56 expect_equal(fnm(1), 2) 57 expect_equal(fnm(1), 2) 58 expect_equal(fnm(1, 2), 3) 59 expect_equal(fnm(1), 2) 60 expect_equal(fnm(1, 2), 3) 61 expect_equal(fnm(), 4) 62 63 expect_true(forget(fnm)) 64 65 expect_equal(fnm(1), 5) 66 expect_equal(fnm(1, 2), 6) 67 expect_equal(fnm(), 7) 68}) 69 70test_that("default arguments are used for hash", { 71 fn <- function(j = 1) { i <<- i + 1; i } 72 i <- 0 73 74 expect_warning(fnm <- memoise(fn), NA) 75 expect_equal(fn(1), 1) 76 expect_equal(fnm(1), 2) 77 expect_equal(fnm(1), 2) 78 expect_equal(fnm(), 2) 79 expect_equal(fnm(2), 3) 80 expect_equal(fnm(), 2) 81}) 82 83test_that("default arguments are evaluated correctly", { 84 expect_false(exists("g")) 85 g <- function() 1 86 fn <- function(j = g()) { i <<- i + 1; i } 87 i <- 0 88 89 expect_warning(fnm <- memoise(fn), NA) 90 expect_equal(fn(1), 1) 91 expect_equal(fnm(1), 2) 92 expect_equal(fnm(1), 2) 93 expect_equal(fnm(), 2) 94 expect_equal(fnm(2), 3) 95 expect_equal(fnm(), 2) 96}) 97 98test_that("symbol collision", { 99 cache <- function(j = 1) { i <<- i + 1; i } 100 i <- 0 101 cachem <- memoise(cache) 102 103 expect_equal(cache(), 1) 104 expect_equal(cache(), 2) 105 expect_equal(cachem(), 3) 106 expect_equal(cachem(), 3) 107 expect_equal(cache(), 4) 108 expect_equal(cachem(), 3) 109 110 expect_true(forget(cachem)) 111 expect_equal(cachem(), 5) 112}) 113 114test_that("different body avoids collisions", { 115 # Same args, different body 116 m <- cachem::cache_mem() 117 times2 <- memoise(function(x) { x * 2 }, cache = m) 118 times4 <- memoise(function(x) { x * 4 }, cache = m) 119 120 expect_identical(times2(10), 20) 121 expect_equal(m$size(), 1) 122 expect_identical(times4(10), 40) 123 expect_equal(m$size(), 2) 124}) 125 126test_that("different formals avoids collisions", { 127 # Different formals (even if not used) avoid collisions, because formals 128 # are used in key. 129 m <- cachem::cache_mem() 130 f <- function(x, y) { x * 2 } 131 times2 <- memoise(function(x, y) { x * 2 }, cache = m) 132 times2a <- memoise(function(x, y = 1) { x * 2 }, cache = m) 133 134 expect_identical(times2(10), 20) 135 expect_equal(m$size(), 1) 136 expect_identical(times2a(10), 20) 137 expect_equal(m$size(), 2) 138}) 139 140test_that("same body results in collisions", { 141 # Two identical memoised functions should result in cache hits so that cache 142 # can be shared more easily. 143 # https://github.com/r-lib/memoise/issues/58 144 m <- cachem::cache_mem() 145 times2 <- memoise(function(x, y) { x * 2 }, cache = m) 146 times2a <- memoise(function(x, y) { x * 2 }, cache = m) 147 148 expect_identical(times2(10), 20) 149 expect_identical(times2a(10), 20) 150 expect_equal(m$size(), 1) 151}) 152 153test_that("same body results in collisions", { 154 # Even though t2 and t4 produce different results, the memoised versions, 155 # times2 and times4, have cache collisions because the functions have the same 156 # body and formals. It would be nice if we could somehow avoid this. 157 m <- cachem::cache_mem() 158 159 t2 <- local({ 160 n <- 2 161 function(x) x * n 162 }) 163 t4 <- local({ 164 n <- 4 165 function(x) x * n 166 }) 167 168 times2 <- memoise(t2, cache = m) 169 times4 <- memoise(t4, cache = m) 170 171 expect_identical(times2(10), 20) 172 expect_identical(times4(10), 20) # Bad (but expected) cache collision! 173 expect_equal(m$size(), 1) 174}) 175 176 177test_that("visibility", { 178 vis <- function() NULL 179 invis <- function() invisible() 180 181 expect_true(withVisible(memoise(vis)())$visible) 182 expect_false(withVisible(memoise(invis)())$visible) 183}) 184 185test_that("is.memoised", { 186 i <- 0 187 expect_false(is.memoised(i)) 188 expect_false(is.memoised(is.memoised)) 189 expect_true(is.memoised(memoise(identical))) 190}) 191 192test_that("visibility", { 193 vis <- function() NULL 194 invis <- function() invisible() 195 196 expect_true(withVisible(memoise(vis)())$visible) 197 expect_false(withVisible(memoise(invis)())$visible) 198}) 199 200test_that("can memoise anonymous function", { 201 expect_warning(fm <- memoise(function(a = 1) a), NA) 202 expect_equal(names(formals(fm))[[1]], "a") 203 expect_equal(fm(1), 1) 204 expect_equal(fm(2), 2) 205 expect_equal(fm(1), 1) 206}) 207 208test_that("can memoise primitive", { 209 expect_warning(fm <- memoise(`+`), NA) 210 expect_equal(names(formals(fm)), names(formals(args(`+`)))) 211 expect_equal(fm(1, 2), 1 + 2) 212 expect_equal(fm(2, 3), 2 + 3) 213 expect_equal(fm(1, 2), 1 + 2) 214}) 215 216test_that("printing a memoised function prints the original definition", { 217 218 fn <- function(j) { i <<- i + 1; i } 219 220 fnm <- memoise(fn) 221 222 fn_output <- capture.output(fn) 223 fnm_output <- capture.output(fnm) 224 225 expect_equal(fnm_output[1], "Memoised Function:") 226 227 expect_equal(fnm_output[-1], fn_output) 228}) 229 230test_that("memoisation can depend on non-arguments", { 231 fn <- function(x) { i <<- i + 1; i } 232 i <- 0 233 j <- 2 234 235 fn2 <- function(y, ...) { 236 fnm <- memoise(fn, ~y) 237 fnm(...) 238 } 239 expect_error(memoise(fn, j), "`j` must be a formula\\.") 240 241 expect_error(memoise(fn, ~j, k), "`k` must be a formula\\.") 242 243 expect_error(memoise(fn, j ~ 1), "`x` must be a one sided formula \\[not j ~ 1\\]\\.") 244 245 fnm <- memoise(fn, ~j) 246 expect_equal(fn(1), 1) 247 expect_equal(fn(1), 2) 248 expect_equal(fnm(1), 3) 249 expect_equal(fnm(1), 3) 250 j <- 1 251 expect_equal(fnm(1), 4) 252 expect_equal(fnm(1), 4) 253 j <- 2 254 expect_equal(fnm(1), 3) 255 expect_equal(fnm(1), 3) 256 j <- 3 257 expect_equal(fnm(1), 5) 258 expect_equal(fnm(1), 5) 259}) 260 261test_that("it fails if already memoised", { 262 mem_sum <- memoise(sum) 263 expect_error(memoise(mem_sum), "`f` must not be memoised.") 264}) 265 266test_that("it evaluates arguments in proper environment", { 267 e <- new.env(parent = baseenv()) 268 e$a <- 5 269 fun <- function(x, y = a) { x + y } 270 environment(fun) <- e 271 fun_mem <- memoise(fun) 272 expect_equal(fun(1), fun_mem(1)) 273 expect_equal(fun(10), fun_mem(10)) 274}) 275 276test_that("it does have namespace clashes with internal memoise symbols", { 277 e <- new.env(parent = baseenv()) 278 e$f <- 5 279 fun <- function(x, y = f) { x + y } 280 environment(fun) <- e 281 fun_mem <- memoise(fun) 282 expect_equal(fun(1), fun_mem(1)) 283 expect_equal(fun(10), fun_mem(10)) 284}) 285 286test_that("arguments are evaluated before hashing", { 287 i <- 1 288 289 f <- memoise(function(x, y, z = 3) { x + y + z}) 290 f2 <- function(x, y) f(x, y) 291 292 expect_equal(f2(1, 1), 5) 293 294 expect_equal(f2(1, 1), 5) 295 296 expect_equal(f2(2, 2), 7) 297}) 298 299test_that("argument names don't clash with names in memoised function body", { 300 f <- function( 301 # Names in enclosing environment of memoising function 302 `_f`, `_cache`, `_additional`, 303 # Names in body of memoising function 304 mc, encl, called_args, default_args, args, hash, res 305 ) list(`_f`, `_cache`, `_additional`, mc, encl, called_args, default_args, args, hash, res) 306 f_mem <- memoise(f) 307 308 expect_error(f_mem(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), NA) 309 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)) 310}) 311 312test_that("omit_args respected", { 313 # If no arguments ignored, these 2 rnorm() calls should have different results 314 mem_rnorm <- memoise(rnorm, omit_args = c()) 315 316 res1 <- mem_rnorm(10, mean = -100) 317 res2 <- mem_rnorm(10, mean = +100) 318 319 expect_false(identical(res1, res2)) 320 321 322 # If 'mean' ignored when hashing, these 2 rnorm() calls will have identical results 323 mem_rnorm <- memoise(rnorm, omit_args = c('mean')) 324 325 res1 <- mem_rnorm(10, mean = -100) 326 res2 <- mem_rnorm(10, mean = +100) 327 328 expect_true(identical(res1, res2)) 329}) 330 331context("has_cache") 332test_that("it works as expected with memoised functions", { 333 mem_sum <- memoise(sum) 334 expect_false(has_cache(mem_sum)(1, 2, 3)) 335 336 mem_sum(1, 2, 3) 337 338 expect_true(has_cache(mem_sum)(1, 2, 3)) 339 340 mem_sum <- memoise(sum) 341 expect_false(has_cache(mem_sum)(1, 2, 3)) 342}) 343 344test_that("it errors with an un-memoised function", { 345 expect_error(has_cache(sum)(1, 2, 3), "`f` is not a memoised function.") 346}) 347 348context("drop_cache") 349test_that("it works as expected with memoised functions", { 350 mem_sum <- memoise(sum) 351 expect_false(drop_cache(mem_sum)(1, 2, 3)) 352 353 mem_sum(1, 2, 3) 354 mem_sum(2, 3, 4) 355 356 expect_true(has_cache(mem_sum)(1, 2, 3)) 357 expect_true(has_cache(mem_sum)(2, 3, 4)) 358 359 expect_true(drop_cache(mem_sum)(1, 2, 3)) 360 361 expect_false(has_cache(mem_sum)(1, 2, 3)) 362 expect_true(has_cache(mem_sum)(2, 3, 4)) 363 364 mem_sum <- memoise(sum) 365 expect_false(drop_cache(mem_sum)(1, 2, 3)) 366}) 367 368test_that("it errors with an un-memoised function", { 369 expect_error(drop_cache(sum)(1, 2, 3), "`f` is not a memoised function.") 370}) 371 372context("timeout") 373test_that("it stays the same if not enough time has passed", { 374 duration <- 10 375 first <- timeout(duration, 0) 376 377 expect_equal(first, timeout(duration, 1)) 378 expect_equal(first, timeout(duration, 5)) 379 expect_equal(first, timeout(duration, 7)) 380 expect_equal(first, timeout(duration, 9)) 381 382 expect_true(first != timeout(duration, 10)) 383 384 385 duration <- 100 386 first <- timeout(duration, 0) 387 388 expect_equal(first, timeout(duration, 10)) 389 expect_equal(first, timeout(duration, 50)) 390 expect_equal(first, timeout(duration, 70)) 391 expect_equal(first, timeout(duration, 99)) 392 393 expect_true(first != timeout(duration, 100)) 394}) 395 396context("missing") 397test_that("it works with missing arguments", { 398 fn <- function(x, y) { 399 i <<- i + 1 400 if (missing(y)) { 401 y <- 1 402 } 403 x + y 404 } 405 fnm <- memoise(fn) 406 i <- 0 407 408 expect_equal(fn(1), fnm(1)) 409 expect_equal(fn(1, 2), fnm(1, 2)) 410 expect_equal(i, 4) 411 fnm(1) 412 expect_equal(i, 4) 413 fnm(1, 2) 414 expect_equal(i, 4) 415}) 416