Merge pull request #182 from animint/driver-variable-value

fix guided tour for variable/value aes (named clickSelects/showSelected)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2025.1.24
+Version: 2025.1.25
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -287,4 +287,3 @@ Collate:
 RoxygenNote: 7.3.2
 Config/Needs/website: tidyverse/tidytemplate
 VignetteBuilder: knitr
-Remotes: rstudio/chromote

NEWS.md

@@ -1,3 +1,9 @@
+# Changes in version 2025.1.25 (PR#182)
+
+- Tour text includes selector names for geoms with named clickSelects/showSelected.
+- `animint2pages(chromote_sleep_seconds=NULL)` is the new default (no screenshot).
+- knit_print.animint supports Start Tour button.
+
 # Changes in version 2025.1.24 (PR#164)
 
 - New Start Tour widget at the bottom of each data viz, which highlights what interactions are possible with each geom. Use `geom_*(title="title for geom in tour", help="details about what this geom is supposed to represent)` to change what is displayed for each geom during the tour. Powered by https://driverjs.com/

R/z_animint.R

@@ -68,7 +68,7 @@ parsePlot <- function(meta, plot, plot.name){
     ## -> handles .value/.variable named params
     ## -> removes duplicates
     ## -> removes duplicates due to showSelected legend
-    L$extra_params <- checkExtraParams(L$extra_params, L$mapping)
+    L$extra_params <- checkExtraParams(L$extra_params, L$mapping, L$data)
 
     ## Add the showSelected/clickSelects params to the aesthetics
     ## mapping before calling ggplot_build

R/z_animintHelpers.R

@@ -31,9 +31,7 @@ addShowSelectedForLegend <- function(meta, legend, L){
         ## used by the geom
         type.vec <- one.legend$legend_type
         if(any(type.vec %in% names(L$mapping))){
-          type.str <- paste(type.vec, collapse="")
-          a.name <- paste0("showSelectedlegend", type.str)
-          L$mapping[[a.name]] <- as.symbol(s.name)
+          L$extra_params$showSelected <- c(L$extra_params$showSelected, s.name)
         }
       }
       ## if selector.types has not been specified, create it
@@ -1047,8 +1045,9 @@ addSSandCSasAesthetics <- function(aesthetics, extra_params){
 ##' @param extra_params named list containing the details of showSelected
 ##' and clickSelects values of the layer
 ##' @param aes_mapping aesthetics mapping of the layer
+##' @param layer_df the data frame
 ##' @return Modified \code{extra_params} list
-checkExtraParams <- function(extra_params, aes_mapping){
+checkExtraParams <- function(extra_params, aes_mapping, layer_df){
   cs.ss <- intersect(names(extra_params), c("showSelected", "clickSelects"))
   for(i in cs.ss){
     ep <- extra_params[[i]]
@@ -1064,11 +1063,23 @@ checkExtraParams <- function(extra_params, aes_mapping){
     }
     ## Remove duplicates
     ep <- ep[ !duplicated(ep) ]
-    ## Remove from extra_params if already added by legend
-    if(i=="showSelected"){
-      ss_added_by_legend <- aes_mapping[grepl(
-        "^showSelectedlegend", names(aes_mapping))]
-      ep <- ep[ !ep %in% ss_added_by_legend ]
+    ## make help string for variable/value aes.
+    named.i <- which(names(ep) != "")
+    extra_params[[paste0("help_",i)]] <- if(length(named.i)==1){
+      var.name <- names(ep)[[named.i]]
+      u.vals <- unique(layer_df[[var.name]])
+      c(ep[-named.i], if(length(u.vals)==1){
+        u.vals
+      }else{
+        disp.vals <- if(length(u.vals)>4){
+          c(u.vals[1:2], "...", u.vals[c(length(u.vals)-1, length(u.vals))])
+        }else{
+          u.vals
+        }
+        sprintf("one of: [%s]", paste(disp.vals, collapse=", "))
+      })
+    }else{
+      ep
     }
     extra_params[[i]] <- ep
   }

R/z_knitr.R

@@ -29,7 +29,9 @@ knit_print.animint <- function(x, options, ...) {
 <script type="text/javascript" src="%s/vendor/jquery-1.11.3.min.js"></script>
 <script type="text/javascript" src="%s/vendor/selectize.min.js"></script>
 <link rel="stylesheet" type="text/css" href="%s/vendor/selectize.css" />
-%s', dir, dir, dir, dir, dir, res)
+<script type="text/javascript" src="%s/vendor/driver.js.iife.js"></script>
+<link rel="stylesheet" href="%s/vendor/driver.css" />
+%s', dir, dir, dir, dir, dir, dir, dir, res)
   }
   knitr::asis_output(res, meta = list(animint = structure("", class = "animint")))
 }

R/z_pages.R

@@ -16,6 +16,7 @@
 #' @param required_opts Character vector of plot.list element names
 #'   which are checked (stop with an error if not present). Use
 #'   required_opts=NULL to skip check.
+#' @param chromote_sleep_seconds if numeric, chromote will be used to take a screenshot of the data viz, pausing this number of seconds to wait for rendering (experimental).
 #' @param ... Additional options passed onto \code{animint2dir}.
 #'
 #' @return The function returns the initialized GitHub repository object.
@@ -36,7 +37,7 @@
 #' }
 #' 
 #' @export
-animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), ...) {
+animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), chromote_sleep_seconds=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))
@@ -48,20 +49,19 @@ animint2pages <- function(plot.list, github_repo, owner=NULL, commit_message = "
       stop(sprintf("Please run `install.packages('%s')` before using this function", pkg))
     }
   }
-
-  if(requireNamespace("chromote") && requireNamespace("magick")) {
+  res <- animint2dir(plot.list, open.browser = FALSE, ...)
+  if(requireNamespace("chromote") && requireNamespace("magick") && is.numeric(chromote_sleep_seconds)) {
     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)
+    Sys.sleep(chromote_sleep_seconds)
     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)
+    Sys.sleep(chromote_sleep_seconds)
     ## Capture screenshot
     chrome.session$screenshot(screenshot_full, selector = ".plot_content")
     image_raw <- magick::image_read(screenshot_full)

inst/examples/WorldBank-facets-map.R

@@ -85,6 +85,7 @@ wb.facets <- animint(
     geom_line(aes(
       year, life.expectancy, group=country, colour=region),
       clickSelects="country",
+      help="Time series of life expectancy, one line per country",
       data=TS(not.na),
       size=4,
       alpha=1,
@@ -93,13 +94,15 @@ wb.facets <- animint(
       year, life.expectancy, colour=region, label=country),
       showSelected="country",
       clickSelects="country",
+      help="Names of selected countries",
       data=TS(min.years),
       hjust=1)+
     ## TS2
     make_widerect(not.na, "year", data.fun=TS2)+
     geom_path(aes(
       fertility.rate, year, group=country, colour=region),
       clickSelects="country",
+      help="Time series of fertility rate, one line per country",
       data=TS2(not.na),
       size=4,
       alpha=1,
@@ -110,6 +113,7 @@ wb.facets <- animint(
       key=country), # key aesthetic for smooth transitions!
       clickSelects="country",
       showSelected="year",
+      help="Scatter plot for the selected year, one point per country",
       alpha=1,
       alpha_off=0.3,
       chunk_vars=character(),
@@ -119,6 +123,7 @@ wb.facets <- animint(
       key=country), #also use key here!
       showSelected=c("country", "year", "region"),
       clickSelects="country",
+      help="Names of selected countries",
       chunk_vars=character(),
       data=SCATTER(not.na))+
     scale_size_animint(breaks=10^(9:5))+
@@ -127,10 +132,12 @@ wb.facets <- animint(
       5, 85, label=paste0("year = ", year),
       key=1),
       showSelected="year",
+      title="Selected year",
       data=SCATTER(years))+
     ## MAP
     geom_polygon(aes(
       x, y, group=group, fill=region),
+      title="World map",
       clickSelects="country",
       color="black",
       color_off="transparent",
@@ -143,6 +150,7 @@ wb.facets <- animint(
   selector.types=list(country="multiple"),
   source="https://github.com/animint/animint2/blob/master/inst/examples/WorldBank-facets-map.R",
   out.dir="WorldBank-facets-map",
+  video="https://vimeo.com/1050117030",
   title="World Bank data (multiple selection, facets)")
 options(browser="firefox")
 wb.facets

inst/examples/test_knit_print.Rmd

@@ -18,15 +18,17 @@ knit_meta()
 library(animint2)
 dat <- data.frame(x = 1:10, y = 1:10, label = rep(c("a178", "b934"), 5))
 animint(q = qplot(
-  x, y, data = dat, colour = label, 
+  x, y, data = dat, colour = label,
+  help="first plot",
   xlab = "first plot with color legend"))
 ```
 
 Clicking on the plot above should not affect the plot below.
 
 ```{r plot.1.bottom}
 animint(q = qplot(
-  x, y, data = dat, colour = label, 
+  x, y, data = dat, colour = label,
+  help="second plot",
   xlab = "second plot with color legend"))
 ```
 

inst/htmljs/animint.js

@@ -190,14 +190,16 @@ var animint = function (to_select, json_file) {
     var geom = g_info.classed;
     var title = g_info.params.title || g_info.classed;
     var helpText = g_info.params.help || '';
-    var showSelected = g_info.params.showSelected || '';
-    var clickSelects = g_info.params.clickSelects || '';
+    var help_showSelected = g_info.params.help_showSelected || '';
+    var help_clickSelects = g_info.params.help_clickSelects || '';
     var description = helpText;
     if(g_info.params.hasOwnProperty("showSelected")){
-      description += '<br>Data are shown for the current selection of: ' + g_info.params.showSelected;
+      if(description != "")description += '<br>';
+      description += 'Data are shown for the current selection of: ' + help_showSelected;
     }
     if(g_info.params.hasOwnProperty("clickSelects")){
-      description += '<br>Click to select: ' + g_info.params.clickSelects;
+      if(description != "")description += '<br>';
+      description += 'Click to select: ' + help_clickSelects;
     }
     if(description == ""){
       description = "No interactions available";

tests/testthat/helper-functions.R

@@ -400,17 +400,17 @@ runtime_evaluate_helper <- function(class_name=NULL, id=NULL, list_num=NULL, dis
     if(isTRUE(dispatch_event))".dispatchEvent(new CustomEvent('click'))"))
 }
 
-driverjs_click_class <- function(class_name){
+driverjs_click_class <- function(class_name,list_num=0){
   runtime_evaluate_helper(
     class_name = class_name,
-    list_num = 0,
+    list_num = list_num,
     dispatch_event = TRUE
   )
   Sys.sleep(1)
   driverjs_get()
 }
 
-driverjs_start <- function()driverjs_click_class("animint_start_tour")
+driverjs_start <- function(list_num=0)driverjs_click_class("animint_start_tour",list_num)
 driverjs_next <- function()driverjs_click_class("driver-popover-next-btn")
 
 driverjs_get <- function(html=getHTML()){

tests/testthat/test-compiler-ghpages.R

@@ -33,7 +33,7 @@ test_that("animint2pages() returns list of meta-data", {
   ## https://docs.github.com/en/rest/repos/repos?apiVersion=2022-11-28#create-an-organization-repository says The fine-grained token must have the following permission set: "Administration" repository permissions (write)
   gh::gh("POST /orgs/animint-test/repos", name="animint2pages_test_repo")
   ## first run of animint2pages creates new data viz.
-  result_list <- animint2pages(viz, "animint2pages_test_repo", owner="animint-test")
+  result_list <- animint2pages(viz, "animint2pages_test_repo", owner="animint-test", chromote_sleep_seconds=3)
   result_list
   expect_match(result_list$owner_repo, "animint2pages_test_repo")
   expect_match(result_list$viz_url, "github.io/animint2pages_test_repo")
@@ -55,7 +55,7 @@ test_that("animint2pages() returns list of meta-data", {
     geom_point(aes(
       x, x),
       data=data.frame(x=1:5))
-  update_list <- animint2pages(viz.more, "animint2pages_test_repo", owner="animint-test")
+  update_list <- animint2pages(viz.more, "animint2pages_test_repo", owner="animint-test", chromote_sleep_seconds=3)
   tsv_files_updated <- get_tsv(update_list)
   expect_equal(length(tsv_files_updated), 2)
   expect_Capture(update_list)