First version of cache implementation with new knitr API

Author: leogama

R/config.R

@@ -756,11 +756,6 @@ python_config <- function(python,
     }
   }
 
-  as_numeric_version <- function(version) {
-    version <- clean_version(version)
-    numeric_version(version)
-  }
-
   # check for numpy
   numpy <- NULL
   if (!is.null(config$NumpyPath)) {
@@ -909,8 +904,9 @@ is_rstudio_desktop <- function() {
   identical(version$mode, "desktop")
 }
 
-clean_version <- function(version) {
-  gsub("\\.$", "", gsub("[A-Za-z_+].*$", "", version))
+as_numeric_version <- function(version) {
+  version <- sub("\\.$", "", sub("[A-Za-z_+].*$", "", version))
+  numeric_version(version)
 }
 
 reticulate_python_versions <- function() {

R/knitr-cache.R

@@ -0,0 +1,99 @@
+#' A reticulate cache engine for Knitr
+#'
+#' This provides a `reticulate` cache engine for `knitr`. The cache engine
+#' allows `knitr` to save and load Python sessions between cached chunks. The
+#' cache engine depends on the `dill` Python module. Therefore, you must have
+#' `dill` installed in your Python environment.
+#'
+#' The engine can be activated by setting (for example)
+#'
+#' ```
+#' knitr::cache_engines$set(python = reticulate::cache_eng_python)
+#' ```
+#'
+#' Typically, this will be set within a document's setup chunk, or by the
+#' environment requesting that Python chunks be processed by this engine.
+#'
+#' @param options
+#'   List of chunk options provided by `knitr` during chunk execution.
+#'   Contains the caching path.
+#'
+#' @export
+cache_eng_python <- (function() {
+  check_cache_available <- function() {
+    # does the python version is supported by 'dill'?
+    if (py_version() < "3.7") {
+      warning("Python cache requires Python version >= 3.7")
+      return(FALSE)
+    }
+
+    # is the module 'dill' loadable?
+    dill <- tryCatch(import("dill"), error = identity)
+    if (inherits(dill, "error")) {
+      error <- reticulate::py_last_error()
+      if (!error$type %in% c("ImportError", "ModuleNotFoundError"))
+        stop(error$value, call. = FALSE)
+      warning("The Python module 'dill' was not found, it's required for Python cache")
+      return(FALSE)
+    }
+
+    # is the 'dill' version recent enough?
+    dill_version <- as_numeric_version(dill$`__version__`)
+    if (dill_version < "0.3.6") {
+      warning("Python cache requires module dill>=0.3.6")
+      return(FALSE)
+    }
+
+    # Python cache is available
+    TRUE
+  }
+
+  cache_available <- function() {
+    available <- knitr::opts_knit$get("reticulate.cache")
+    if (is.null(available)) {
+      available <- check_cache_available()
+      knitr::opts_knit$set(reticulate.cache = available)
+    }
+    available
+  }
+
+  cache_path <- function(path) {
+    paste(path, "pkl", sep=".")
+  }
+
+  cache_exists <- function(options) {
+    file.exists(cache_path(options$hash))
+  }
+
+  cache_load <- function(options) {
+    eng_python_initialize(options, envir = environment())
+    if (!cache_available()) return()
+    dill <- import("dill")
+    dill$load_module(filename = cache_path(options$hash), module = "__main__")
+  }
+
+  filter <- NULL
+  r_obj_filter <- function() {
+    if (is.null(filter)) {
+      filter <<- py_eval("lambda obj: obj.name == 'r' and type(obj.value) is __builtins__.__R__")
+    }
+    filter
+  }
+
+  cache_save <- function(options) {
+    if (!cache_available()) return()
+    dill <- import("dill")
+    tryCatch({
+      dill$dump_module(cache_path(options$hash), refimported = TRUE, exclude = r_obj_filter())
+    }, error = function(e) {
+      cache_purge(options$hash)
+      stop(e)
+    })
+  }
+
+  cache_purge <- function(glob_path) {
+    unlink(cache_path(glob_path))
+  }
+
+  list(exists = cache_exists, load = cache_load, save = cache_save, purge = cache_purge)
+})()

R/knitr-engine.R

@@ -253,10 +253,6 @@ eng_python <- function(options) {
     outputs$push(output)
   }
 
-  if (options$cache > 0) {
-    save_python_session(options$hash)
-  }
-
   # if we had held outputs, add those in now (merging text output as appropriate)
   text_output <- character()
 
@@ -305,16 +301,6 @@ eng_python_initialize <- function(options, envir) {
   ensure_python_initialized()
   eng_python_initialize_hooks(options, envir)
 
-  if (options$cache > 0) {
-    module <- tryCatch(import("dill"), error = identity)
-    if (inherits(module, "error")) {
-      if (module$message == "ImportError: No module named dill") {
-        warning("The Python module dill was not found. This module is needed for full cache functionality.")
-      } else {
-        stop(module$message)
-      }
-    }
-  }
 }
 
 eng_python_knit_figure_path <- function(options, suffix = NULL) {
@@ -416,7 +402,7 @@ eng_python_initialize_matplotlib <- function(options, envir) {
     if ("matplotlib.backends" %in% names(sys$modules)) {
       matplotlib$pyplot$switch_backend("agg")
     } else {
-      version <- numeric_version(matplotlib$`__version__`)
+      version <- as_numeric_version(matplotlib$`__version__`)
       if (version < "3.3.0")
         matplotlib$use("agg", warn = FALSE, force = TRUE)
       else
@@ -661,52 +647,3 @@ eng_python_autoprint <- function(captured, options, autoshow) {
   }
 
 }
-
-save_python_session <- function(cache_path) {
-  module <- tryCatch(import("dill"), error = identity)
-  if (inherits(module, "error")) {
-    if (module$message == "ImportError: No module named dill") return()
-    signalCondition(module$message)
-  }
-
-  r_obj_exists <- "'r' in globals()"
-  r_is_R <- "type(r).__module__ == '__main__' and type(r).__name__ == 'R'"
-  if (py_eval(r_obj_exists) && py_eval(r_is_R)) {
-    py_run_string("del globals()['r']")
-  }
-
-  cache_path <- file.path(knitr::opts_knit$get("output.dir"), cache_path)
-  module$dump_session(filename = paste0(cache_path, ".pkl"), byref = TRUE)
-}
-
-#' A reticulate cache engine for Knitr
-#'
-#' This provides a `reticulate` cache engine for `knitr`. The cache engine
-#' allows `knitr` to save and load Python sessions between cached chunks. The
-#' cache engine depends on the `dill` Python module. Therefore, you must have
-#' `dill` installed in your Python environment.
-#'
-#' The engine can be activated by setting (for example)
-#'
-#' ```
-#' knitr::cache_engines$set(python = reticulate::cache_eng_python)
-#' ```
-#'
-#' Typically, this will be set within a document's setup chunk, or by the
-#' environment requesting that Python chunks be processed by this engine.
-#'
-#' @param options
-#'   List of chunk options provided by `knitr` during chunk execution.
-#'   Contains the caching path.
-#'
-#' @export
-cache_eng_python <- function(options) {
-  module <- tryCatch(import("dill"), error = identity)
-  if (inherits(module, "error")) {
-    if (module$message == "ImportError: No module named dill") return()
-    stop(module$message)
-  }
-
-  cache_path <- normalizePath(paste0(options$hash, ".pkl"), mustWork = TRUE)
-  knitr:::in_input_dir(module$load_session(filename = cache_path))
-}

R/python.R

@@ -274,14 +274,14 @@ as.environment.python.builtin.object <- function(x) {
   if (inherits(x, "python.builtin.dict")) {
 
     names <- py_dict_get_keys_as_str(x)
-    names <- names[substr(names, 1, 1) != '_']
+    names <- names[substr(names, 1, 1) != "_"]
     Encoding(names) <- "UTF-8"
     types <- rep_len(0L, length(names))
 
   } else {
     # get the names and filter out internal attributes (_*)
     names <- py_suppress_warnings(py_list_attributes(x))
-    names <- names[substr(names, 1, 1) != '_']
+    names <- names[substr(names, 1, 1) != "_"]
     # replace function with `function`
     names <- sub("^function$", "`function`", names)
     names <- sort(names, decreasing = FALSE)
@@ -1351,43 +1351,45 @@ py_filter_classes <- function(classes) {
 }
 
 py_inject_r <- function() {
-
   # don't inject 'r' if there's already an 'r' object defined
   main <- import_main(convert = FALSE)
   if (py_has_attr(main, "r"))
     return(FALSE)
 
-  # define our 'R' class
-  py_run_string("class R(object): pass")
-
-  # extract it from the main module
-  main <- import_main(convert = FALSE)
-  R <- main$R
+  builtins <- import_builtins(convert = FALSE)
+  if (!py_has_attr(builtins, "__R__")) {
+    # define our 'R' class
+    py_run_string("class R(object): pass")
+    R <- main$R
+
+    # copy it to 'builtins'
+    py_set_attr(builtins, "__R__", R)
+
+    # remove the 'R' class object from '__main__'
+    py_del_attr(main, "R")
+
+    # define the getters, setters we'll attach to the Python class
+    getter <- function(self, code) {
+      envir <- py_resolve_envir()
+      object <- eval(parse(text = as_r_value(code)), envir = envir)
+      r_to_py(object, convert = is.function(object))
+    }
 
-  # define the getters, setters we'll attach to the Python class
-  getter <- function(self, code) {
-    envir <- py_resolve_envir()
-    object <- eval(parse(text = as_r_value(code)), envir = envir)
-    r_to_py(object, convert = is.function(object))
-  }
+    setter <- function(self, name, value) {
+      envir <- py_resolve_envir()
+      name  <- as_r_value(name)
+      value <- as_r_value(value)
+      assign(name, value, envir = envir)
+    }
 
-  setter <- function(self, name, value) {
-    envir <- py_resolve_envir()
-    name  <- as_r_value(name)
-    value <- as_r_value(value)
-    assign(name, value, envir = envir)
+    py_set_attr(R, "__getattr__", getter)
+    py_set_attr(R, "__setattr__", setter)
+    py_set_attr(R, "__getitem__", getter)
+    py_set_attr(R, "__setitem__", setter)
   }
 
-  py_set_attr(R, "__getattr__", getter)
-  py_set_attr(R, "__setattr__", setter)
-  py_set_attr(R, "__getitem__", getter)
-  py_set_attr(R, "__setitem__", setter)
-
   # now define the R object
-  py_run_string("r = R()")
-
-  # remove the 'R' class object
-  py_del_attr(main, "R")
+  py_run_string("r = __R__()")
 
   # indicate success
   TRUE

R/testthat-helpers.R

@@ -109,7 +109,7 @@ skip_if_no_scipy <- function() {
     skip("scipy not available for testing")
 
   scipy <- import("scipy")
-  if (clean_version(scipy$`__version__`) < "1.0")
+  if (as_numeric_version(scipy$`__version__`) < "1.0")
     skip("scipy version is less than v1.0")
 
 }