add support for animint(video="http://...")

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2024.11.27
+Version: 2025.1.21
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(

NEWS.md

@@ -1,3 +1,9 @@
+# Changes in version 2025.1.21 (PR#181)
+
+- `animint(video="https://some.url")` renders the link at the bottom
+  of the data viz.
+- `update_gallery()` uses `download.file()` instead of git clone (faster).
+
 # Changes in version 2024.11.27 (PR#170)
 
 - When scale_log10 changes -Inf to NA, Inf handling logic now works

R/z_animint.R

@@ -304,16 +304,16 @@ animint2dir <- function(plot.list, out.dir = NULL,
   if(is.list(plot.list$title)){
     plot.list$title <- plot.list$title[[1]]
   }
-  if(is.character(plot.list$title)){
-    meta$title <- plot.list$title[[1]]
-    plot.list$title <- NULL
-  }
   if(!is.null(plot.list$out.dir)){
     plot.list$out.dir <- NULL
   }
-  if(is.character(plot.list[["source"]])){
-    meta$source <- plot.list[["source"]]
-    plot.list$source <- NULL
+  char_attr_names <- c("source","video","title")
+  for(attr_name in char_attr_names){
+    maybe_char <- plot.list[[attr_name]]
+    if(is.character(maybe_char) && length(maybe_char)==1 && !is.na(maybe_char)){
+      meta[[attr_name]] <- maybe_char
+      plot.list[[attr_name]] <- NULL
+    }
   }
 
   ## Extract essential info from ggplots, reality checks.
@@ -643,7 +643,8 @@ animint2dir <- function(plot.list, out.dir = NULL,
   meta$time <- AnimationInfo$time
   meta$timeValues <- AnimationInfo$timeValues
   export.names <- c(
-    "geoms", "time", "duration", "selectors", "plots", "title", "source")
+    "geoms", "time", "duration", "selectors", "plots",
+    char_attr_names)
   export.data <- list()
   for(export.name in export.names){
     if(export.name %in% ls(meta)){

R/z_pages.R

@@ -167,39 +167,6 @@ check_no_github_repo <- function(owner, repo) {
   )
 }
 
-get_pages_info <- function(viz_owner_repo){
-  viz_dir <- tempfile()
-  origin_url <- paste0("https://github.com/", viz_owner_repo, ".git")
-  gert::git_clone(origin_url, viz_dir)
-  gert::git_branch_checkout("gh-pages", repo=viz_dir)
-  Capture.PNG <- file.path(viz_dir, "Capture.PNG")
-  if(!file.exists(Capture.PNG)){
-    stop(sprintf("gh-pages branch of %s should contain file named Capture.PNG (screenshot of data viz)", viz_owner_repo))
-  }
-  plot.json <- file.path(viz_dir, "plot.json")
-  jlist <- RJSONIO::fromJSON(plot.json)
-  commit.row <- gert::git_log(max=1, repo=viz_dir)
-  repo.row <- data.table(
-    viz_owner_repo, Capture.PNG, commit.POSIXct=commit.row$time)
-  to.check <- c(
-    source="URL of data viz source code",
-    title="string describing the data viz")
-  for(attr.name in names(to.check)){
-    attr.value <- jlist[[attr.name]]
-    if(
-      is.character(attr.value)
-      && length(attr.value)==1
-      && !is.na(attr.value)
-      && nchar(attr.value)>0
-    ){
-      set(repo.row, j=attr.name, value=attr.value)
-    }else{
-      stop(sprintf("plot.json file in gh-pages branch of %s should have element named %s which should be %s", viz_owner_repo, attr.name, to.check[[attr.name]]))
-    }
-  }
-  repo.row
-}
-
 ##' A gallery is a collection of meta-data about animints that have
 ##' been published to github pages. A gallery is defined as a github
 ##' repo that should have two source files in the gh-pages branch:
@@ -224,22 +191,53 @@ update_gallery <- function(gallery_path="~/R/gallery"){
   repos.txt <- file.path(gallery_path, "repos.txt")
   repos.dt <- fread(repos.txt,header=FALSE,col.names="viz_owner_repo")
   meta.csv <- file.path(gallery_path, "meta.csv")
-  old.meta <- fread(meta.csv)
-  todo.meta <- repos.dt[!old.meta, on="viz_owner_repo"]
+  if(file.exists(meta.csv)){
+    old.meta <- fread(meta.csv)
+    todo.meta <- repos.dt[!old.meta, on="viz_owner_repo"]
+  }else{
+    old.meta <- NULL
+    todo.meta <- repos.dt
+  }
   meta.dt.list <- list(old.meta)
   error.dt.list <- list()
   add.POSIXct <- Sys.time()
   for(viz_owner_repo in todo.meta[["viz_owner_repo"]]){
     tryCatch({
-      meta.row <- data.table(add.POSIXct, get_pages_info(viz_owner_repo))
-      meta.dt.list[[viz_owner_repo]] <- meta.row[, .(
-        add.POSIXct, viz_owner_repo, commit.POSIXct, source, title)]
-      Capture.PNG <- meta.row[["Capture.PNG"]]
+      viz_url <- function(filename)sprintf(
+        "https://raw.githubusercontent.com/%s/refs/heads/gh-pages/%s",
+        viz_owner_repo, filename)
       repo.png <- file.path(
         gallery_path, "repos", paste0(viz_owner_repo, ".png"))
-      user.dir <- dirname(repo.png)
-      dir.create(user.dir, showWarnings = FALSE, recursive = TRUE)
-      file.copy(Capture.PNG, repo.png, overwrite = TRUE)
+      if(!file.exists(repo.png)){
+        download.file(viz_url("Capture.PNG"), repo.png)
+      }
+      local.json <- tempfile()
+      download.file(viz_url("plot.json"), local.json)
+      jlist <- RJSONIO::fromJSON(local.json)
+      to.check <- c(
+        source="URL of data viz source code",
+        title="string describing the data viz")
+      repo.row <- data.table()
+      repo.row$video <- if("video" %in% names(jlist)){
+        jlist$video
+      }else{
+        NA_character_
+      }
+      for(attr.name in names(to.check)){
+        attr.value <- jlist[[attr.name]]
+        if(
+          is.character(attr.value)
+          && length(attr.value)==1
+          && !is.na(attr.value)
+          && nchar(attr.value)>0
+        ){
+          set(repo.row, j=attr.name, value=attr.value)
+        }else{
+          stop(sprintf("plot.json file in gh-pages branch of %s should have element named %s which should be %s", viz_owner_repo, attr.name, to.check[[attr.name]]))
+        }
+      }
+      meta.dt.list[[viz_owner_repo]] <- data.table(
+        add.POSIXct, viz_owner_repo, repo.row)
     }, error=function(e){
       error.dt.list[[viz_owner_repo]] <<- data.table(
         add.POSIXct, viz_owner_repo, error=e$message)

inst/examples/gps.R

@@ -122,8 +122,9 @@ villes.start.end[, let(
 city.text.size <- 15
 where.colors <- c(start="white",end="black")
 viz <- animint(
-  title="Toby Hocking Bike Rides 2009",
+  title="Map and time series of Toby Hocking's Bike Rides in 2009",
   source="https://github.com/animint/animint2/blob/master/inst/examples/gps.R",
+  video="https://vimeo.com/1048533960",
   map=ggplot()+
     ggtitle("Map of rides, click to select ride")+
     theme_bw()+

inst/htmljs/animint.js

@@ -2200,8 +2200,14 @@ var animint = function (to_select, json_file) {
       .append("th")
       .text("Selected value(s)")
     ;
-
-     // looping through and adding a row for each selector
+    // video link
+    if(response.hasOwnProperty("video")){
+      widget_td.append("a")
+	.attr("class","a_video_href")
+	.attr("href", response.video)
+	.text("video");
+    }
+    // looping through and adding a row for each selector
     for(s_name in Selectors) {
       var s_info = Selectors[s_name];
       // for .variable .value selectors, levels is undefined and we do

tests/testthat/test-renderer2-widerect.R

@@ -1,7 +1,8 @@
 acontext("geom_widerect")
 library(animint2)
-expect_source <- function(expected){
-  a.list <- getNodeSet(info$html, '//a[@class="a_source_href"]')
+expect_href <- function(kind, expected){
+  xpath <- sprintf('//a[@class="a_%s_href"]', kind)
+  a.list <- getNodeSet(info$html, xpath)
   computed <- if(length(a.list)==0){
     NULL
   }else{
@@ -11,6 +12,16 @@ expect_source <- function(expected){
   expect_identical(as.character(computed), as.character(expected))
 }
 
+video.viz <- animint(
+  ggplot()+
+    geom_point(aes(x, y), data=data.frame(x=1,y=2)),
+  video="http://tdhock.github.io")
+info <- animint2HTML(video.viz)
+test_that("video link for animint(video='foo')", {
+  expect_href("source", NULL)
+  expect_href("video", "http://tdhock.github.io")
+})
+
 recommendation <- data.frame(
   min.C=21,
   max.C=23)
@@ -33,7 +44,10 @@ viz <- animint(
 )
 
 info <- animint2HTML(viz)
-expect_source(NULL)
+test_that("no source/video links rendered by default", {
+  expect_href("source", NULL)
+  expect_href("video", NULL)
+})
 
 clickSelector <- function(selectorName) {  
   script.txt <- sprintf('childDom = document.getElementsByClassName("%s")[0]; childDom.getElementsByClassName("selectize-input")[0].dispatchEvent(new CustomEvent("click"));', selectorName)
@@ -128,7 +142,10 @@ wb.facets <- animint(
   source="https://github.com/animint/animint2/blob/master/tests/testthat/test-renderer2-widerect.R")
 
 info <- animint2HTML(wb.facets)
-expect_source("https://github.com/animint/animint2/blob/master/tests/testthat/test-renderer2-widerect.R")
+test_that("source link rendered for animint(source='foo')", {
+  expect_href("source", "https://github.com/animint/animint2/blob/master/tests/testthat/test-renderer2-widerect.R")
+  expect_href("video", NULL)
+})
 
 rect.list <- getNodeSet(
   info$html, '//svg[@id="plot_ts"]//rect[@class="border_rect"]')
@@ -152,13 +169,11 @@ test_that("three unique border_rect y values (no vert space)", {
 })
 
 line.xpath <- '//g[@class="geom2_line_ts"]//g[@class="PANEL4"]//path'
-opacityPattern <-
-  paste0("opacity:",
-         "(?<value>.*?)",
-         ";")
-
+opacityPattern <- paste0(
+  "opacity:",
+  "(?<value>.*?)",
+  ";")
 test_that("line opacity initially 0.1 or 0.6", {
-
   node.set <- getNodeSet(info$html, line.xpath)
   opacity.list <- list()
   for(node.i in seq_along(node.set)){
@@ -170,27 +185,22 @@ test_that("line opacity initially 0.1 or 0.6", {
     opacity.list[[node.id]] <- as.numeric(opacity.mat[, "value"])
   }
   opacity.vec <- do.call(c, opacity.list)
-
   selected.computed <- as.numeric(opacity.vec[wb.facets$first$country])
   selected.expected <- rep(0.6, length(selected.computed))
   expect_equal(selected.computed, selected.expected)
-
   unselected.computed <-
     as.numeric(opacity.vec[!names(opacity.vec) %in% wb.facets$first$country])
   unselected.expected <- rep(0.1, length(unselected.computed))
   expect_equal(unselected.computed, unselected.expected)
-
 })
 
-dasharrayPattern <-
-  paste0("stroke-dasharray:",
-         "(?<value>.*?)",
-         ";")
-
-rect.xpaths <-
-  c('//g[@class="geom6_widerect_ts"]//g[@class="PANEL1"]//rect',
-    '//g[@class="geom1_tallrect_ts"]//g[@class="PANEL4"]//rect')
-
+dasharrayPattern <- paste0(
+  "stroke-dasharray:",
+  "(?<value>.*?)",
+  ";")
+rect.xpaths <- c(
+  '//g[@class="geom6_widerect_ts"]//g[@class="PANEL1"]//rect',
+  '//g[@class="geom1_tallrect_ts"]//g[@class="PANEL4"]//rect')
 test_that("wide/tallrect renders a <rect> for every year", {
   for(rect.xpath in rect.xpaths){
     node.set <- getNodeSet(info$html, rect.xpath)