Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Debug mode? #129

Open
DarwinAwardWinner opened this issue May 5, 2021 · 0 comments
Open

Debug mode? #129

DarwinAwardWinner opened this issue May 5, 2021 · 0 comments

Comments

@DarwinAwardWinner
Copy link

DarwinAwardWinner commented May 5, 2021

I've recently been writing a bunch of code using memoise to let me "skip" long computation steps on subsequent runs. However, in the process I have run into repeated issues where the arguments to my memoised functions were not identical on successive runs of the same code (and that code doesn't do RNG), and debugging these issues has been a challenge. It would be nice if there was a "verbose mode" that could at least show the hashes of individual arguments and the final hash computed as the key to look up in the cache, so I can at least figure out which argument is changing unexpectedly between runs. In addition, I've found the following functions useful for debugging caching issues, and they might be worth including in the package (with some cleanup, obviously):

# Return TRUE if FUN has a memoised result for calling on these args
is_cached <- function(FUN, ...) {
    args <- list(...)
    if (!is.memoised(FUN)) {
        return(FALSE)
    }
    test_memo_f <- function(...) {
        mc <- match.call()
        encl <- parent.env(environment())
        called_args <- as.list(mc)[-1]
        default_args <- encl$`_default_args`
        default_args <- default_args[setdiff(names(default_args),
                                             names(called_args))]
        called_args[encl$`_omit_args`] <- NULL
        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`$exists(key)
    }
    formals(test_memo_f) <- formals(FUN)
    environment(test_memo_f) <- environment(FUN)
    do.call(test_memo_f, args)
}

# Like do.call but throws an error if the call is not memoised
do_call_memo_only <- function(FUN, ...) {
    args <- list(...)
    if (!is.memoised(FUN)) {
        stop("Function is not memoised")
    }
    memo_only_f <- function(...) {
        mc <- match.call()
        encl <- parent.env(environment())
        called_args <- as.list(mc)[-1]
        default_args <- encl$`_default_args`
        default_args <- default_args[setdiff(names(default_args),
                                             names(called_args))]
        called_args[encl$`_omit_args`] <- NULL
        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")) {
            stop("Call is not cached")
        }
        if (res$visible) {
            res$value
        }
        else {
            invisible(res$value)
        }
    }
    formals(memo_only_f) <- formals(FUN)
    environment(test_memo_f) <- environment(FUN)
    do.call(memo_only_f, args)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant