Improve animint2pages by automatically taking screenshot of the animint

.github/workflows/tests.yaml

@@ -26,7 +26,7 @@ jobs:
       - run: /usr/bin/sudo DEBIAN_FRONTEND=noninteractive apt install tidy texlive texlive-fonts-extra -y
       - uses: r-lib/actions/setup-r@v2
       - uses: r-lib/actions/setup-r-dependencies@v2
-        
+
       - name: install package
         run: R CMD INSTALL .
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2024.9.17
+Version: 2024.9.18
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -101,7 +101,8 @@ Suggests:
     rpart,
     svglite,
     ggplot2,
-    chromote
+    chromote,
+    magick
 License: GPL-3
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -452,6 +452,7 @@ export(scale_y_log10)
 export(scale_y_reverse)
 export(scale_y_sqrt)
 export(should_stop)
+export(start_servr)
 export(stat_bin)
 export(stat_bin2d)
 export(stat_bin_2d)
@@ -477,6 +478,7 @@ export(stat_summary_bin)
 export(stat_summary_hex)
 export(stat_unique)
 export(stat_ydensity)
+export(stop_server)
 export(theme)
 export(theme_animint)
 export(theme_bw)

NEWS.md

@@ -1,3 +1,7 @@
+# Changes in version 2024.9.18 (PR#131)
+
+  - Added functionality to capture screenshot in animint2pages
+
 # Changes in version 2024.9.17
 
 - @export for internal S3 methods, to quiet roxygen2::document() messages.

R/utilities.r

@@ -280,3 +280,29 @@ dispatch_args <- function(f, ...) {
   formals(f) <- formals
   f
 }
+
+start_servr <- function(serverDirectory = ".", port = 4848,
+                      code = "servr::httd(dir='%s', port=%d)",
+                      tmpPath = ".") {
+  dir <- normalizePath(serverDirectory, winslash = "/", mustWork = TRUE)
+  cmd <- sprintf(
+    paste("write.table(Sys.getpid(), file='%s', append=T, row.name=F, col.names=F);", code),
+    file.path(tmpPath, "pids.txt"), dir, port
+  )
+  system2("Rscript", c("-e", shQuote(cmd)), wait = FALSE)
+}
+
+stop_server <- function(tmpPath = ".") {
+  res <- TRUE
+  f <- file.path(tmpPath, "pids.txt")
+  if (file.exists(f)) {
+    e <- try(readLines(con <- file(f), warn = FALSE), silent = TRUE)
+    if (!inherits(e, "try-error")) {
+      pids <- as.integer(e)
+      res <- c(res, tools::pskill(pids))
+    }
+    close(con)
+    unlink(f)
+  }
+  res
+}

R/z_animint.R

@@ -248,7 +248,7 @@ 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 = "", ...) {
   if(is.null(out.dir)){
     out.dir <- tempfile()
   }

R/z_pages.R

@@ -23,34 +23,55 @@
 #' @examples
 #' \dontrun{
 #' library(animint2)
-#' p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) +
-#'   geom_point()
-#' p2 <- ggplot(mtcars, aes(x = hp, y = wt)) +
-#'   geom_point()
-#' viz <- list(plot1 = p1, plot2 = p2)
-#' animint2pages(
-#'   viz,
-#'   github_repo = "my_animint2_plots",
-#'   commit_message = "New animint",
-#'   private = TRUE)
+#' mtcars$Cyl <- factor(mtcars$cyl)
+#' viz <- animint(
+#'   ggplot(mtcars, aes(x = mpg, y = disp, color=Cyl)) +
+#'     geom_point(),
+#'   ggplot(mtcars, aes(x = hp, y = wt, color=Cyl)) +
+#'     geom_point(),
+#'   title="Motor Trend Cars data viz",
+#'   source="https://github.com/animint/animint2/blob/master/R/z_pages.R"
+#' )
+#' animint2pages(viz, "animint2pages-example-mtcars")
 #' }
-#'
+#' 
 #' @export
 animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), ...) {
   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
+  ## Check for required packages
   for(pkg in c("gert", "gh")){
     if (!requireNamespace(pkg)) {
       stop(sprintf("Please run `install.packages('%s')` before using this function", pkg))
     }
   }
-  # Generate plot files
-  res <- animint2dir(plot.list, open.browser = FALSE, ...)
-  # Select non-ignored files to post
+
+  if(requireNamespace("chromote") && requireNamespace("magick")) {
+    chrome.session <- chromote::ChromoteSession$new()
+    res <- animint2dir(plot.list, open.browser = FALSE, ...)
+    #Find available port and start server
+    portNum <- servr::random_port()
+    normDir <- normalizePath(res$out.dir, winslash = "/", mustWork = TRUE)
+    start_servr(serverDirectory = normDir, port = portNum, tmpPath = normDir)
+    Sys.sleep(3)
+    url <- sprintf("http://localhost:%d", portNum)
+    chrome.session$Page$navigate(url)
+    screenshot_path <- file.path(res$out.dir, "Capture.PNG")
+    screenshot_full <- file.path(res$out.dir, "Capture_full.PNG")
+    Sys.sleep(3)
+    ## Capture screenshot
+    chrome.session$screenshot(screenshot_full, selector = ".plot_content")
+    image_raw <- magick::image_read(screenshot_full)
+    image_trimmed <- magick::image_trim(image_raw)
+    magick::image_write(image_trimmed, screenshot_path)
+    unlink(screenshot_full)
+    chrome.session$close()
+    # Stop the server
+    stop_server(normDir)
+  }
   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))]
@@ -78,7 +99,7 @@ animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "
     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
+  ## check if repo has commit, if not, give it first commit, this can avoid error
   has_commits <- FALSE
   try(
     {
@@ -93,7 +114,7 @@ animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "
     if(!is.character(title))title <- "New animint visualization"
     initial_commit(local_clone, repo, viz_url, title)
   }
-  # Handle gh-pages branch
+  ## Handle gh-pages branch
   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))

inst/htmljs/animint.js

@@ -148,6 +148,10 @@ var animint = function (to_select, json_file) {
   var element = d3.select(to_select);
   this.element = element;
   var viz_id = element.attr("id");
+  var plot_widget_table = element.append("table");
+  var plot_td = plot_widget_table.append("tr").append("td");
+  plot_td.attr("class","plot_content");
+  var widget_td = plot_widget_table.append("tr").append("td");
   var Widgets = {};
   this.Widgets = Widgets;
   var Selectors = {};
@@ -218,7 +222,7 @@ var animint = function (to_select, json_file) {
     // Each plot may have one or more legends. To make space for the
     // legends, we put each plot in a table with one row and two
     // columns: tdLeft and tdRight.
-    var plot_table = element.append("table").style("display", "inline-block");
+    var plot_table = plot_td.append("table").style("display", "inline-block");
     var plot_tr = plot_table.append("tr");
     var tdLeft = plot_tr.append("td");
     var tdRight = plot_tr.append("td").attr("class", p_name+"_legend");
@@ -303,7 +307,7 @@ var animint = function (to_select, json_file) {
 	return measureText(entry, p_info.ysize).width + 5;
       }));
     }
-    var axispaddingx = 10 + 20;
+    var axispaddingx = 30; // distance between tick marks and x axis name.
     if(p_info.hasOwnProperty("xlabs") && p_info.xlabs.length){
       // TODO: throw warning if text height is large portion of plot height?
       axispaddingx += Math.max.apply(null, p_info.xlabs.map(function(entry){
@@ -2049,15 +2053,14 @@ var animint = function (to_select, json_file) {
     ////////////////////////////////////////////
     // Widgets at bottom of page
     ////////////////////////////////////////////
-    element.append("br");
     if(response.hasOwnProperty("source")){
-      element.append("a")
+      widget_td.append("a")
 	.attr("id","a_source_href")
 	.attr("href", response.source)
 	.text("source");
     }
     // loading table.
-    var show_hide_table = element.append("button")
+    var show_hide_table = widget_td.append("button")
       .text("Show download status table");
     show_hide_table
       .on("click", function(){
@@ -2069,7 +2072,7 @@ var animint = function (to_select, json_file) {
           show_hide_table.text("Show download status table");
         }
       });
-    var loading = element.append("table")
+    var loading = widget_td.append("table")
       .style("display", "none");
     Widgets["loading"] = loading;
     var tr = loading.append("tr");
@@ -2087,7 +2090,7 @@ var animint = function (to_select, json_file) {
     // Animation control widgets.
     var show_message = "Show animation controls";
     // add a button to view the animation widgets
-    var show_hide_animation_controls = element.append("button")
+    var show_hide_animation_controls = widget_td.append("button")
       .text(show_message)
       .attr("id", viz_id + "_show_hide_animation_controls")
       .on("click", function(){
@@ -2101,7 +2104,7 @@ var animint = function (to_select, json_file) {
       })
     ;
     // table of the animint widgets
-    var time_table = element.append("table")
+    var time_table = widget_td.append("table")
       .style("display", "none");
     var first_tr = time_table.append("tr");
     var first_th = first_tr.append("th");
@@ -2178,13 +2181,13 @@ var animint = function (to_select, json_file) {
         d3.select(".urltable").style("display","none")
       }
     }
-    var show_hide_selector_widgets = element.append("button")
+    var show_hide_selector_widgets = widget_td.append("button")
       .text(toggle_message)
       .attr("class", "show_hide_selector_widgets")
       .on("click", show_or_hide_fun)
     ;
     // adding a table for selector widgets
-    var selector_table = element.append("table")
+    var selector_table = widget_td.append("table")
       .style("display", "none")
       .attr("class", "table_selector_widgets")
     ;

tests/testthat/helper-functions.R

@@ -351,18 +351,8 @@ tests_run <- function(dir = ".", filter = NULL) {
 #' @seealso \link{tests_run}
 #' @export
 tests_exit <- function() {
-  res <- stop_binary()
   Sys.unsetenv("ANIMINT_BROWSER")
-  f <- file.path(find_test_path(), "pids.txt")
-  if (file.exists(f)) {
-    e <- try(readLines(con <- file(f), warn = FALSE), silent = TRUE)
-    if (!inherits(e, "try-error")) {
-      pids <- as.integer(e)
-      res <- c(res, tools::pskill(pids))
-    }
-    close(con)
-    unlink(f)
-  }
+  res <- stop_server(tmpPath = find_test_path())
   invisible(all(res))
 }
 
@@ -374,31 +364,14 @@ tests_exit <- function() {
 #' @param port port number to _attempt_ to run server on.
 #' @param code R code to execute in a child session
 #' @return port number of the successful attempt
-run_servr <- function(directory = ".", port = 4848,
-                      code = "servr::httd(dir='%s', port=%d)") {
-  dir <- normalizePath(directory, winslash = "/", mustWork = TRUE)
-  cmd <- sprintf(
-    paste("write.table(Sys.getpid(), file='%s', append=T, row.name=F, col.names=F);", code),
-    file.path(find_test_path(), "pids.txt"), dir, port
-  )
-  system2("Rscript", c("-e", shQuote(cmd)), wait = FALSE)
+run_servr <- function(directory, port) {
+  start_servr(directory, port, tmpPath = find_test_path())
 }
 
 # --------------------------
 # Functions that are used in multiple places
 # --------------------------
 
-stop_binary <- function() {
-  if (exists("pJS")) pJS$stop()
-  # these methods are really queries to the server
-  # thus, if it is already shut down, we get some arcane error message
-  e <- try({
-    remDr$closeWindow()
-    remDr$closeServer()
-  }, silent = TRUE)
-  TRUE
-}
-
 # find the path to animint's testthat directory
 find_test_path <- function(dir = ".") {
   dir <- normalizePath(dir, winslash = "/", mustWork = TRUE)

tests/testthat/test-compiler-ghpages.R

@@ -1,5 +1,4 @@
 acontext("GitHub Pages")
-
 library(animint2)
 viz <- animint(
   title="one to ten",
@@ -46,6 +45,10 @@ test_that("animint2pages() returns list of meta-data", {
   get_tsv <- function(L)Sys.glob(file.path(L$local_clone, "*tsv"))
   tsv_files_created <- get_tsv(result_list)
   expect_equal(length(tsv_files_created), 1)
+  expect_Capture <- function(L){
+    expect_gt(file.size(file.path(L$local_clone,"Capture.PNG")), 0)
+  }
+  expect_Capture(result_list)
   ## second run of animint2pages updates data viz.
   viz.more <- viz
   viz.more$five <- ggplot()+
@@ -55,6 +58,7 @@ test_that("animint2pages() returns list of meta-data", {
   update_list <- animint2pages(viz.more, "animint2pages_test_repo", owner="animint-test")
   tsv_files_updated <- get_tsv(update_list)
   expect_equal(length(tsv_files_updated), 2)
+  expect_Capture(update_list)
 })
 
 test_that("animint2pages raises an error if no GitHub token is present", {