Optimisation des performances en R : un exemple avec l'utilisation de Mémoise

Contexte

Table des matières

Que ce soit pendant les (formations) que je peux donner ou les (coaching) que je peux faire, il y a bien souvent un moment où je pars dans un long laïus sur la puissance et l’utilité du caching. De à quel point c’est génial, pas si compliqué que ça à mettre en place et super intéressant.

La dernière fois que j’ai fait une présentation c’était pour parler de ({targets}) mais dans cet article, on va faire un focus sur un package plus “simple”, mais extrêmement efficace. On va parler de {memoise}, qui saura se rendre indispensable pour vos analyses ou vos applications Shiny.

{memoise} est un package qui contient une fonction memoise(), c’est dans cette dernière que se concentre la principale fonctionnalité.

memoise::memoise() est une fonction qui prend en paramètre une autre fonction, et qui retourne une fonction qui aura la particularité d’avoir une mémoire, et de ne pas refaire les calculs pour rien. Un exemple ? Ok.

Démonstration

Construisons calcul_long et sa version “mémoisée”

calcul_long <- function(x){
  Sys.sleep(3)
  x*3
}
calcul_long_mem <- memoise::memoise(calcul_long)

Si j’exécute calcul_long, alors je devrais systématiquement attendre 3 secondes le résultat.

system.time({  calcul_long(x = 2) })
#>    user  system elapsed 
#>   0.018   0.005   3.000
system.time({  calcul_long(x = 3) })
#>    user  system elapsed 
#>   0.009   0.013   3.000
system.time({  calcul_long(x = 2) })
#>    user  system elapsed 
#>   0.017   0.008   3.000

Par contre, la fonction calcul_long_mem ne me fera attendre 3 secondes que la première fois et me retournera directement le résultat les fois suivantes (si je lui redemande exactement la même chose bien sûr).

system.time({  calcul_long_mem(x = 2) })
#>    user  system elapsed 
#>   0.016   0.005   3.001
system.time({  calcul_long_mem(x = 3) })
#>    user  system elapsed 
#>   0.010   0.013   3.001
system.time({  calcul_long_mem(x = 2) })
#>    user  system elapsed 
#>   0.001   0.000   0.000
system.time({  calcul_long_mem(x = 2) })
#>    user  system elapsed 
#>       0       0       0
system.time({  calcul_long_mem(x = 2) })
#>    user  system elapsed 
#>   0.001   0.000   0.000
system.time({  calcul_long_mem(x = 3) })
#>    user  system elapsed 
#>       0       0       0

Pratique non ?

Un cache persistant

Par défaut, la mémoire est temporaire, limitée à votre session R, c’est mieux que rien, mais on peut faire mieux et utiliser un stockage disque pour rendre la mémoire persistante.

Pour faire ça proprement, on va utiliser rappdirs::user_cache_dir() qui se chargera de retourner un dossier de cache persistant et de manière cohérente pour tous les OS.

dossier_cache <- rappdirs::user_cache_dir("calcul_long_dir")
cd <- cachem::cache_disk(dir =  dossier_cache)
calcul_long_mem2 <- memoise::memoise(calcul_long,cache = cd)

Et voilà !

Maintenant calcul_long_mem2 stockera tout son savoir dans un dossier du disque, il sera partagé entre session R, celles d’aujourd’hui et celles de demain.

system.time({  calcul_long_mem2(x = 2) })
#>    user  system elapsed 
#>   0.001   0.000   0.001
system.time({  calcul_long_mem2(x = 3) })
#>    user  system elapsed 
#>   0.001   0.000   0.000
system.time({  calcul_long_mem2(x = 2) })
#>    user  system elapsed 
#>       0       0       0

Fonctionnement

Si on analyse un peu ce qu’il vient de se passer, alors on remarque que dans le dossier de cache s’accumulent des fichiers rds qui contiennent la mémoire de la fonction.


fs::dir_tree(dossier_cache)
#> ~/.cache/calcul_long_dir
#> ├── 000c2eaa9359e329edb0fc4a01a8c0c5.rds
#> ├── 26a9a952a6f2b8c413604e732771d2e5.rds
#> ├── 2d6da9f223e1b062c5681f2e9f942ef8.rds
#> ├── 32c041e836202daa0a80ef4c7e269f15.rds
#> ├── 77252f4a89517c08a4f5f89de0440705.rds
#> ├── 830207659dfd7c44baa0f49d74d443db.rds
#> └── 8717feae48bb1499ca487fd679167cd6.rds

À la première exécution d’un appel de la fonction, un nouveau .rds est fabriqué, tandis que pour les suivants, le rds correspondant est lu et renvoyé à l’utilisateur.

Mise en oeuvre

Voici un exemple de mise en œuvre,

Imaginons que nous disposons de la fonction ocr_pdf_ qui est capable d’analyser un fichier pdf pour en retourner tout plein d’information, elle est plutôt lente à tourner et passe par un service payant. Voyons comment implémenter dans un package une approche optimisée, afin de minimiser le temps d’exécution.


#' extract data from pdf
#'
#' @param file pdf file to parse
#' @param apikey token
#'
#' @return a list
#' @noRd
ocr_pdf_ <- function(file,apikey){
Sys.sleep(1)
  file
}
# memoised `ocr_pdf_` function
#'
#' @param memoise_cache_dir cache directory
#'
#' @return a list
#' @export
#' @importFrom cachem cache_disk
#' @importFrom memoise memoise
#' @importFrom rappdirs user_cache_dir
#' @noRd
ocr_pdf_mem <- function(memoise_cache_dir = getOption(
  "ocr_memoise_dir",
  default = rappdirs::user_cache_dir("ocr")
)
) {
  cd <- cachem::cache_disk(dir =  memoise_cache_dir)
  memoise::memoise(ocr_pdf_,cache = cd)
}
#' extract data from pdf
#' @param file pdf file to parse
#' @param apikey token
#' @export
#' @rdname ocr_pdf
ocr_pdf <- ocr_pdf_mem()
# Clean `ocr_pdf_mem` cache
#'
#' @param memoise_cache_dir cache directory
#'
#' @export
#' @importFrom rappdirs user_cache_dir
#' @rdname ocr_pdf
clean_memoise_cache_ocr <- function(memoise_cache_dir = getOption("ocr_memoise_dir",
                                                                  default = rappdirs::user_cache_dir("ocr"))){
  message("cleaning ",memoise_cache_dir," folder")
  unlink(memoise_cache_dir,recursive = TRUE,force = TRUE)
}

Vous noterez que l’utilisateur pourra utiliser la fonction ocr_pdf et que celle-ci utilisera un cache persistant, et qu’au besoin la fonction clean_memoise_cache_ocr effacera ce cache. Un utilisateur un peu plus “fin” pourra directement faire appel à la fonction `ocr_pdf_mem pour jouer avec les dossiers de cache.

À vous de vous en inspirer pour vos cas d’usages.

Un cas plus complexe

Un petit bonbon pour la fin, un peu plus ambitieux et exploratoire, pour vous donner des idées.
Comment utiliser {memoise}, pour mettre en place un système de cache pour le rendu de Rmd basé sur rmarkdown::render() ?

A priori ce n’est pas si trivial puisque le comportement par défaut de memoise va poser souci :

Dans rmarkdown::render(input = "rapport.Rmd"), les différents input ne changent pas en tant que tel puisque le chemin source du Rmd sera toujours le même, même si le contenu de celui-ci change.
On utilise la fonction render() pour son “side effect”, c’est-à-dire qu’elle ne retourne rien directement à l’utilisateur et elle génère un HTML sur le disque.

Pour faire en sorte que memoise détecte un changement de contenu dans le fichier Rmd source, on va générer le hash du contenu de ce Rmd et le passer en paramètre de la fonction. Il y aurait plein de choses à dire sur le concept de hash, si vous n’êtes pas familier de cette notion, retenez que :

Deux fichiers identiques auront le même hash,
À la moindre virgule rajoutée dans le Rmd, le hash va changer,
Et il est (quasiment) impossible que deux objets différents aient le même hash.

Pour générer ce hash, on va utiliser le package {digest} comme ceci digest::digest(readLines("raport.Rmd")).

Voici une proposition d’implémentation :

D’abord, on va faire en sorte que la fonction retourne à l’utilisateur le contenu du HTML (c’est ça qu’on sauvegardera).

rmd_to_html_ <- function(input,hash=NULL
                         ,...
                         ){
  message("rendering")
  a <- rmarkdown::render(input = input,output_file =tempfile(), ...)
  out <- readLines(a)
  invisible(out)
}
file.copy(from = system.file("rmd","site","index.Rmd",package = "rmarkdown"),to="./a.Rmd")
#> [1] FALSE
a <- rmd_to_html_(input = "a.Rmd")
#> rendering
#> 
#> 
#> processing file: a.Rmd
#> 
  |                                                                                                                      
  |                                                                                                                |   0%
  |                                                                                                                      
  |................................................................................................................| 100%
#> output file: a.knit.md
#> /usr/lib/rstudio-server/bin/quarto/bin/tools/pandoc +RTS -K512m -RTS a.knit.md --to html4 --from markdown+autolink_bare_uris+tex_math_single_backslash --output /tmp/Rtmp1j3QTy/file3ecda11c83384d.html --lua-filter /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmarkdown/lua/pagebreak.lua --lua-filter /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmarkdown/lua/latex-div.lua --embed-resources --standalone --variable bs3=TRUE --section-divs --template /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmd/h/default.html --no-highlight --variable highlightjs=1 --variable theme=bootstrap --mathjax --variable 'mathjax-url=https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML' --include-in-header /tmp/Rtmp1j3QTy/rmarkdown-str3ecda14ba5eeeb.html
#> 
#> Output created: /tmp/Rtmp1j3QTy/file3ecda11c83384d.html
# avec cat on peut refabriquer le fichier
# cat(a,file = "test.html")
# browseURL("test.html")

avec cat() on pourra refabriquer le fichier html

cat(a,file = "test.html")
browseURL("test.html")

on implémente un cache persistant

dossier_cache <- rappdirs::user_cache_dir("rmd_dir")
cd <- cachem::cache_disk(dir =  dossier_cache)
rmd_to_html <- memoise::memoise(rmd_to_html_,cache = cd)

on fabrique une fonction user friendly


compile_rmd <- function(input, output = tempfile(fileext = ".html")) {
  html_content <-
    rmd_to_html(input = input, hash = digest::digest(readLines(input)))
  cat(html_content, file = output)
  output
}

Tadaa


file.copy(from = system.file("rmd","site","index.Rmd",package = "rmarkdown"),to="./file1.Rmd")
#> [1] FALSE
compile_rmd(input = "file1.Rmd") 
#> [1] "/tmp/Rtmp1j3QTy/file3ecda12abf5b3a.html"
compile_rmd(input = "file1.Rmd") # instantané
#> [1] "/tmp/Rtmp1j3QTy/file3ecda11c2fd776.html"
cat("\n newline \n",file = "file1.Rmd",append = TRUE)
compile_rmd(input = "file1.Rmd") # le fichier a changé donc on relance la compilation
#> rendering
#> 
#> 
#> processing file: file1.Rmd
#> 
  |                                                                                                                      
  |                                                                                                                |   0%
  |                                                                                                                      
  |................................................................................................................| 100%
#> output file: file1.knit.md
#> /usr/lib/rstudio-server/bin/quarto/bin/tools/pandoc +RTS -K512m -RTS file1.knit.md --to html4 --from markdown+autolink_bare_uris+tex_math_single_backslash --output /tmp/Rtmp1j3QTy/file3ecda12505b85e.html --lua-filter /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmarkdown/lua/pagebreak.lua --lua-filter /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmarkdown/lua/latex-div.lua --embed-resources --standalone --variable bs3=TRUE --section-divs --template /home/vincent/R/x86_64-pc-linux-gnu-library/4.2.2/rmarkdown/rmd/h/default.html --no-highlight --variable highlightjs=1 --variable theme=bootstrap --mathjax --variable 'mathjax-url=https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML' --include-in-header /tmp/Rtmp1j3QTy/rmarkdown-str3ecda15c2c8b4c.html
#> 
#> Output created: /tmp/Rtmp1j3QTy/file3ecda12505b85e.html
#> [1] "/tmp/Rtmp1j3QTy/file3ecda148755619.html"
compile_rmd(input = "file1.Rmd") # instantané
#> [1] "/tmp/Rtmp1j3QTy/file3ecda167fd745d.html"

Ok, c’est bien, mais quid des fichiers images qui seraient à afficher dans le HTML, dans le cas où l’on n’est pas en HTML standalone ?

On va repenser tout cela pour gérer la gestion des dépendances physiques, et le plus simple sera de déplacer tous les fichiers dans un dossier à côté du HTML et d’adapter le code source.

Voici une proposition d’implémentation :

compile_rmd2 <-
  function(input, output = tempfile(fileext = ".html")) {
    html_content <-
      rmd_to_html(input = input, hash = digest::digest(readLines(input)))
    # on preparer le dossier de destination    
    dossier_destination <- dirname(output)
    dir.create(file.path(dossier_destination, "images"),showWarnings = FALSE,recursive = TRUE)
    images_a_gerer <-  get_images_to_pimp(
      html_content = html_content,
      dossier_destination = dirname(output),
      folder_name = "images"
    )
    # on bouge les images
    move_images(images_a_gerer)
    # on édite le html
    html_content %>% search_and_replace_in_txt(
      pattern =     images_a_gerer %>% map_chr("source"),
      replacement = images_a_gerer %>% map_chr("rewrite")
    ) %>%
      cat(file = output)
    output
  }

avec les outils suivants :

#' @importFrom stringr str_replace_all
search_and_replace_in_txt <- function(txt,pattern, replacement){
  if (length(pattern)==0){return(txt)}
     motifs <- setNames(replacement,pattern)
     str_replace_all(string = txt, motifs)
}
#' @importFrom purrr map
#' @importFrom stringr str_subset
#' @importFrom rvest read_html html_nodes html_attr
get_images_to_pimp <- function(html_content,dossier_destination=".",folder_name ="images"){
      read_html(paste(html_content, sep = "", collapse = "")) %>%
      html_nodes("img") %>%
      html_attr("src") %>%
      stringr::str_subset(negate = TRUE, "^data") %>% 
      unique() %>%
      map( ~ list(
        source = .x,
        destination = file.path(dossier_destination, folder_name, basename(.x)),
        rewrite = file.path(".", folder_name, basename(.x))
        ))
}
#' @importFrom fs file_copy
#' @importFrom purrr map
move_images <- function(images_a_gerer){
      images_a_gerer %>%
        map( ~ fs::file_copy(
        overwrite = TRUE,
        path = .x$source,
        new_path = .x$destination
      ))
}

A vous d’expérimenter 🙂

library(tidyverse)
library(rvest)
compile_rmd2(input = "b_avec_img.Rmd") %>% browseURL()
# debugonce(compile_rmd2)
compile_rmd2(input = "a.Rmd") %>% browseURL()
compile_rmd2(input = "b.Rmd") %>% browseURL()

header source image : https://alterconf.com/speakers/anjana-vakil

Optimisation des performances en R : un exemple avec l’utilisation de Mémoise

Contexte

Démonstration

Un cache persistant

Fonctionnement

Mise en oeuvre

Un cas plus complexe

Related

À propos de l'auteur

Comments

Also read

Découvrez Rlinguo, une application mobile native avec du R

Programmation parallèle et asynchrone dans Shiny avec future, promise, future_promise, et ExtendedTask

Signature.py: application lauréate du Shiny Contest 2024

+33185091403

Notre calendrier

R Niveau 2 – Développeur – Création de packages – Formation certifiante janvier 2025

R Niveau 1 – Utilisateur – Analyse de données – Formation certifiante Janvier 2025

Programmation orientée objet dans R (R6) – Janvier 2025

Blog ThinkR

Déboguer une fonction avec debugonce() ou browser()

Dessinez pour gagner : L’impact des maquettes sur vos apps Shiny

Gérer et manipuler des dates en 2024 : une année pas comme les autres !