Improve animint2pages by automatically taking screenshot of the animint

.github/workflows/tests.yaml

@@ -29,7 +29,7 @@ jobs:
       - uses: r-lib/actions/setup-r@v2
       - uses: r-lib/actions/setup-r-dependencies@v2
         with: 
-          extra-packages: digest, RJSONIO, gtable, plyr, reshape2, scales, knitr
+          extra-packages: digest, RJSONIO, gtable, plyr, reshape2, scales, knitr,chromote, gh,magick
 
 
       - name: install package

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2024.3.12
+Version: 2024.7.5
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -100,7 +100,10 @@ Suggests:
     nlme,
     rpart,
     svglite,
-    ggplot2
+    ggplot2,
+    chromote,
+    gh,
+    magick
 Remotes: ropensci/RSelenium@v1.7.4
 License: GPL-3
 Encoding: UTF-8

NEWS.md

@@ -1,3 +1,7 @@
+# Changes in version 2024.7.5 (PR#131)
+
+  - Added functionality to capture screenshot in animint2pages
+
 # Changes in version 2024.3.12 (PR#119)
 
   - Add validation checks for duplicate args passed geom and aes

R/z_animint.R

@@ -248,23 +248,31 @@ storeLayer <- function(meta, g, g.data.varied){
 #' @example inst/examples/animint2dir.R
 animint2dir <- function(plot.list, out.dir = NULL,
                         json.file = "plot.json", open.browser = interactive(),
-                        css.file = "") {
+                        css.file = "",persistent_server=FALSE, ...) {
   if(is.null(out.dir)){
     out.dir <- tempfile()
   }
   animint.js <- file.path(out.dir, "animint.js")
-  if(dir.exists(out.dir) && !file.exists(animint.js)){
+  if(dir.exists(out.dir) && !file.exists(animint.js) && persistent_server==FALSE){
     stop(animint.js, " does not exist, so not removing out.dir. If you really want to save your animint in out.dir, then please remove that directory entirely")
   }
-  unlink(out.dir, recursive=TRUE)
+  if(persistent_server==FALSE){
+    unlink(out.dir, recursive=TRUE)
+  }
+
   ## Check plot.list for errors
   checkPlotList(plot.list)
 
   ## Store meta-data in this environment, so we can alter state in the
   ## lower-level functions.
   meta <- newEnvironment()
   meta$selector.types <- plot.list$selector.types
-  dir.create(out.dir,showWarnings=FALSE)
+  if(persistent_server==FALSE){
+
+    dir.create(out.dir,showWarnings=FALSE)
+
+  }
+
   meta$out.dir <- out.dir
   ## First, copy html/js/json files to out.dir.
   src.dir <- system.file("htmljs",package="animint2")

R/z_pages.R

@@ -1,3 +1,4 @@
+
 #' Publish a list of ggplots as interactive visualizations on a GitHub repository
 #'
 #' This function takes a named list of ggplots, generates interactive animations,
@@ -35,12 +36,17 @@
 #' }
 #'
 #' @export
-animint2pages <- function(plot.list, github_repo, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), ...) {
+
+
+
+animint2pages <- function(plot.list, github_repo, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"),server=NULL, ...) {
+
   for(opt in required_opts){
     if(!opt %in% names(plot.list)){
       stop(sprintf("plot.list does not contain option named %s, which is required by animint2pages", opt))
     }
   }
+
   # Check for required packages
   for(pkg in c("gert", "gh")){
     if (!requireNamespace(pkg)) {
@@ -49,7 +55,38 @@ animint2pages <- function(plot.list, github_repo, commit_message = "Commit from
   }
   # Generate plot files
   res <- animint2dir(plot.list, open.browser = FALSE, ...)
-  # Select non-ignored files to post
+
+  portNum <- servr::random_port()
+  chrome.session <- chromote::ChromoteSession$new()
+
+
+  if (is.null(server)) {
+    res <- animint2dir(plot.list, open.browser = FALSE, ...)
+    portNum <- servr::random_port()
+    normDir <- normalizePath(res$out.dir, winslash = "/", mustWork = TRUE)
+    code = sprintf("servr::httd(dir='%s', port=%d)", normDir, portNum)
+    system2("Rscript", c("-e", shQuote(code)), wait = FALSE)
+    Sys.sleep(3)
+    url <- sprintf("http://localhost:%d", portNum)
+    chrome.session$Page$navigate(url)
+  }else{
+    res <- animint2dir(plot.list, open.browser = FALSE,out.dir=server$output.dir,persistent_server=TRUE, ...)
+    url <- sprintf("http://localhost:%d",8080)
+    chrome.session$Page$navigate(url)
+  }
+
+  screenshot_path <- file.path(res$out.dir, "Capture.PNG")
+
+  Sys.sleep(3)
+
+  # Capture screenshot
+  screenshot <- chrome.session$Page$captureScreenshot()
+  image_raw <- magick::image_read(jsonlite::base64_dec(screenshot$data))
+  image_trimmed <- magick::image_trim(image_raw)
+  magick::image_write(image_trimmed, screenshot_path)
+
+  chrome.session$close()
+
   all_files <- Sys.glob(file.path(res$out.dir, "*"))
   file_info <- file.info(all_files)
   to_post <- all_files[!(file_info$size == 0 | grepl("~$", all_files))]
@@ -75,6 +112,7 @@ animint2pages <- function(plot.list, github_repo, commit_message = "Commit from
     repo <- gert::git_clone(origin_url, local_clone)
   }
   viz_url <- paste0("https://", owner, ".github.io/", github_repo)
+
   # check if repo has commit, if not, give it first commit, this can avoid error
   has_commits <- FALSE
   try(
@@ -92,6 +130,7 @@ animint2pages <- function(plot.list, github_repo, commit_message = "Commit from
   manage_gh_pages(repo, to_post, local_clone, commit_message)
   message(sprintf(
     "Visualization will be available at %s\nDeployment via GitHub Pages may take a few minutes...", viz_url))
+
   viz_owner_repo
 }
 

tests/testthat/test-compiler-ghpages.R

@@ -1,5 +1,17 @@
 acontext("GitHub Pages")
+library(gh)
+server <- function() {
+  out.dir <- tempfile()
+
+  dir.create(out.dir, showWarnings=FALSE, recursive=TRUE)
+  portNum <- 8080
+  normDir <- normalizePath(out.dir, winslash = "/", mustWork = TRUE)
+  code = sprintf("servr::httd(dir='%s', port=%d)", normDir,portNum)
+  system2("Rscript", c("-e", shQuote(code)), wait = FALSE)
+  return(list(output.dir = normDir))
+}
 
+s<-server()
 viz <- animint(
   title="one to ten",
   source="https://github.com/animint/animint2/tree/master/tests/testthat/test-compiler-ghpages.R",
@@ -10,23 +22,38 @@ test_that("error for viz with no title", {
   viz.no.title <- viz
   viz.no.title$title <- NULL
   expect_error({
-    animint2pages(viz.no.title, "no-title")
+    animint2pages(viz.no.title, "no-title",server=s)
   }, "plot.list does not contain option named title, which is required by animint2pages")
 })
 
 test_that("error for viz with no source", {
   viz.no.source <- viz
   viz.no.source$source <- NULL
   expect_error({
-    animint2pages(viz.no.source, "no-source")
+    animint2pages(viz.no.source, "no-source",server=s)
   }, "plot.list does not contain option named source, which is required by animint2pages")
 })
 
 test_that("animint2pages() returns owner/repo string", {
-  viz_owner_repo <- animint2pages(viz, github_repo = "animint2pages_test_repo")
+  viz_owner_repo <- animint2pages(viz, github_repo = "animint2pages_test_repo",server=s)
   expect_is(viz_owner_repo, "character")
 })
 
+test_that("check if animint2pages() successfully uploads screenshot", {
+
+  viz_owner_repo <- animint2pages(viz, github_repo = "animint2pages_test_repo",server=s)
+  split_viz_owner_repo <- strsplit(viz_owner_repo, "/")[[1]]
+  repo_owner <- split_viz_owner_repo[1]
+  repo_name <- split_viz_owner_repo[2]
+
+  file_exists <- {
+    gh("GET /repos/:owner/:repo/contents/:path",
+       owner = repo_owner, repo = repo_name, path = "Capture.PNG",ref ="gh-pages")
+    TRUE  # If the call succeeds, the file exists
+  }
+  expect_true(file_exists, info = "The screenshot should exist in the repository.")
+})
+
 test_that("animint2pages raises an error if no GitHub token is present", {
   env.names <- c("GITHUB_PAT", "GITHUB_PAT_GITHUB_COM")
   env.old <- Sys.getenv(env.names)
@@ -40,7 +67,7 @@ test_that("animint2pages raises an error if no GitHub token is present", {
   file.copy(config.file, config.old, overwrite = TRUE)
   cat("[credential]\n\tusername = FOO", file=config.file, append=TRUE)
   expect_error({
-    animint2pages(viz, github_repo = "test_repo")
+    animint2pages(viz, github_repo = "test_repo",server=s)
   }, "A GitHub token is required to create and push to a new repository. \nTo create a GitHub token, follow these steps:\n1. Go to https://github.com/settings/tokens/new?scopes=repo&description=animint2pages\n2. Confirm your password if prompted.\n3. Ensure that the 'repo' scope is checked.\n4. Click 'Generate token' at the bottom of the page.\n5. Copy the generated token.\nAfter creating the token, you can set it up in your R environment by running: \nSys.setenv(GITHUB_PAT=\"yourGithubPAT\") \ngert::git_config_global_set(\"user.name\", \"yourUserName\") \ngert::git_config_global_set(\"user.email\", \"yourEmail\") \n", fixed=TRUE)
   do.call(Sys.setenv, as.list(env.old))
   file.copy(config.old, config.file, overwrite = TRUE)