shiny tests using chromote

DESCRIPTION

@@ -109,7 +109,8 @@ Suggests:
     svglite,
     ggplot2,
     chromote,
-    magick
+    magick,
+    callr
 License: GPL-3
 Encoding: UTF-8
 LazyData: true

R/z_knitr.R

@@ -99,7 +99,6 @@ renderAnimint <- function(expr, env = parent.frame(), quoted = FALSE) {
   renderFunc <- function(shinysession, name, ...) {
     val <- func()
     tmp <- tempfile()
-    dir.create(tmp)
     stuff <- animint2dir(val, out.dir = tmp, open.browser = FALSE)
     shiny::addResourcePath("animintAssets", tmp)
     list(jsonFile = "plot.json")

inst/examples/rmarkdown/index.Rmd

@@ -8,9 +8,12 @@ runtime: shiny
 [Animint](https://github.com/tdhock/animint) is an R package for creating web-based interactive graphics and animations using ggplot2’s grammar of graphics approach. Now you can embed animint plots inside [shiny apps](http://shiny.rstudio.com/). In the shiny app below, you can change the x/y/color variables and both plots will update.
 
 ```{r embedded}
-library(shiny)
+setwd(normalizePath(file.path("..", "..", "..")))
+if (!dir.exists("inst/examples/shiny")) {
+  stop("Working directory is not the repository root: ", getwd())
+}
 shinyAppDir(
-  system.file("examples/shiny", package = "animint2"),
+  "inst/examples/shiny",
   options = list(width = "100%", height = 500)
 )
 ```
@@ -90,4 +93,3 @@ renderAnimint({
 ```{r sessionInfo}
 sessionInfo()
 ```
-

inst/examples/rmarkdown/runDoc.R

@@ -1 +1 @@
-rmarkdown::run(system.file("examples/rmarkdown/index.Rmd", package = "animint2"))
+rmarkdown::run("inst/examples/rmarkdown/index.Rmd")

inst/examples/shiny-WorldBank/server.R

@@ -1,13 +1,51 @@
 library(shiny)
 library(animint2)
+library(maps)
 data(WorldBank)
 WorldBank$literacy <- WorldBank[["15.to.25.yr.female.literacy"]]
 WorldBank$latitude <- as.numeric(paste(WorldBank$latitude))
 WorldBank$longitude <- as.numeric(paste(WorldBank$longitude))
+# Map data processing (from first code)
+map_df <- animint2::map_data("world")
+country2region <- with(unique(WorldBank[, c("region","country")]), structure(region, names=country))
+map2wb <- c(
+  Antigua="Antigua and Barbuda",
+  Brunei="Brunei Darussalam",
+  Bahamas="Bahamas, The", 
+  "Democratic Republic of the Congo"="Congo, Dem. Rep.",
+  "Republic of Congo"="Congo, Rep.",
+  "Ivory Coast"="Cote d'Ivoire",
+  Egypt="Egypt, Arab Rep.", 
+  Micronesia="Micronesia, Fed. Sts.",
+  UK="United Kingdom",
+  Gambia="Gambia, The",
+  Iran="Iran, Islamic Rep.",
+  Kyrgyzstan="Kyrgyz Republic",
+  "Saint Kitts"="St. Kitts and Nevis", 
+  "North Korea"="Korea, Dem. Rep.",
+  "South Korea"="Korea, Rep.",
+  Laos="Lao PDR",
+  "Saint Lucia"="St. Lucia",
+  "North Macedonia"="Macedonia, FYR", 
+  Palestine="West Bank and Gaza",
+  Russia="Russian Federation", 
+  Slovakia="Slovak Republic",
+  "Saint Martin"="Sint Maarten (Dutch part)",
+  Syria="Syrian Arab Republic", 
+  Trinidad="Trinidad and Tobago",
+  Tobago="Trinidad and Tobago",
+  USA="United States",
+  "Saint Vincent"="St. Vincent and the Grenadines", 
+  Venezuela="Venezuela, RB",
+  "Virgin Islands"="Virgin Islands (U.S.)",
+  Yemen="Yemen, Rep.")
+map_disp <- with(map_df, data.frame(
+  group, country=ifelse(region %in% names(map2wb), map2wb[region], region)))
+map_disp$region <- country2region[map_disp$country]
 is.discrete <- function(x){
   is.factor(x) || is.character(x) || is.logical(x)
 }
-
+# server.R
 shinyServer(function(input, output) {
 
   getViz <- reactive({
@@ -19,6 +57,7 @@ shinyServer(function(input, output) {
     TS <- function(df)BOTH(df, "Years", input$y)
     SCATTER <- function(df)BOTH(df, input$x, input$y)
     TS2 <- function(df)BOTH(df, input$x, "Years")
+    MAP <- function(df)BOTH(df, "Years", "Years")
     y.na <- WorldBank[[input$y]]
     x.na <- WorldBank[[input$x]]
     not.na <- WorldBank[!(is.na(y.na) | is.na(x.na)),]
@@ -37,6 +76,17 @@ shinyServer(function(input, output) {
     data_i <-  SCATTER(not.na)
     data_i$color <- input$color
 
+    # Process map coordinates (from first code)
+    first.year <- min(WorldBank$year, na.rm=TRUE)
+    last.year <- max(WorldBank$year, na.rm=TRUE)
+    map_names <- c(x="long", y="lat")
+    for(new.var in names(map_names)){
+      old.var <- map_names[[new.var]]
+      old.val <- map_df[[old.var]]
+      m <- min(old.val)
+      old.01 <- (old.val-m)/(max(old.val)-m)
+      map_disp[[new.var]] <- old.01*(last.year-first.year)+first.year
+    }
     gg <-
       ggplot()+
         theme_bw()+
@@ -111,6 +161,16 @@ shinyServer(function(input, output) {
           showSelected=c("country","year", "color"),
           clickSelects="country", 
           data=data_i)+
+        # Add world map polygon (from first code)
+        geom_polygon(aes(
+            x, y, group=group, fill=region),
+          title="World map",
+          clickSelects="country",
+          color="black",
+          color_off="transparent",
+          alpha=1,
+          alpha_off=0.3,
+          data=MAP(map_disp))+
         facet_grid(side ~ top, scales="free")+
         geom_text(aes(x, y,
           label=paste0("year = ", year)),
@@ -134,4 +194,4 @@ shinyServer(function(input, output) {
     getViz()
   })
 
-})
+})

tests/testthat/helper-HTML.R

@@ -127,13 +127,22 @@ start_js_coverage <- function() {
 stop_js_coverage <- function() {
   tryCatch({
     cov <- remDr$Profiler$takePreciseCoverage()
+    results <- cov$result
+    # Filter to only the main animint.js script
+    results <- Filter(function(x) grepl("animint.js", x$url), results)
+    if (length(results) == 0) {
+      warning("No animint.js coverage collected.")
+      return(FALSE)
+    }
+    # Get the single, true path to animint.js
+    local_path <- normalizePath(system.file("htmljs", "animint.js", package = "animint2"))
+    # Update all relevant entries to point to this one local file
+    for (i in seq_along(results)) {
+      results[[i]]$url <- local_path
+    }
+    # Write to a single output file
     outfile <- "js-coverage.json"
-    # Ensure the format matches what v8-to-istanbul expects
-    coverage_data <- list(
-      result = cov$result,
-      url = "http://localhost:4848/animint-htmltest/animint.js"
-    )
-    jsonlite::write_json(coverage_data, outfile, auto_unbox = TRUE)
+    jsonlite::write_json(list(result = results), outfile, auto_unbox = TRUE, pretty = TRUE)
     message("JS coverage saved to ", normalizePath(outfile))
     TRUE
   }, error = function(e) {

tests/testthat/helper-functions.R

@@ -368,6 +368,43 @@ run_servr <- function(directory, port) {
   animint2:::start_servr(directory, port, tmpPath = find_test_path())
 }
 
+# Helper function to start Shiny app 
+start_app <- function(app_type = c("shiny", "rmd"), path, port) {
+  app_type <- match.arg(app_type)
+  if (app_type == "shiny" && !dir.exists(path)) {
+    stop("App directory does not exist: ", path)
+  }
+  if (app_type == "rmd" && !file.exists(path)) {
+    stop("RMarkdown file does not exist: ", path)
+  }
+  app_url <- sprintf("http://127.0.0.1:%d", port)
+  proc <- callr::r_bg(
+    function(app_type, path, port) {
+      if (app_type == "shiny") {
+        shiny::runApp(path, port = port, launch.browser = FALSE)
+      } else {
+        rmarkdown::run(file = path, shiny_args = list(port = port, launch.browser = FALSE))
+      }
+    },
+    args = list(app_type = app_type, path = path, port = port)
+  )
+  Sys.sleep(6)
+  # Wait for startup
+  start_time <- Sys.time()
+  app_started <- FALSE
+  while (Sys.time() - start_time < 30) {
+    if (!proc$is_alive()) stop(app_type, " app failed")
+    con <- try(socketConnection("localhost", port, open = "r+", timeout = 5), silent = FALSE)
+    if (!inherits(con, "try-error")) {
+      close(con)
+      app_started <- TRUE
+      break
+    }
+    Sys.sleep(2)
+  }
+  if (!app_started) stop("Failed to start ", app_type, " app after 30 seconds")
+  return(list(proc = proc, url = app_url))
+}
 # --------------------------
 # Functions that are used in multiple places
 # --------------------------

tests/testthat/test-renderer4-shiny.R

@@ -0,0 +1,98 @@
+print("Running shiny tests...")
+port <- 3147
+setwd(normalizePath(file.path("..", "..")))
+test_that("animint plot renders in a shiny app", {
+  app_dir <- file.path("inst", "examples", "shiny")
+  if (!dir.exists(app_dir)) skip("Shiny app directory not found")
+  app_info <- start_app("shiny", app_dir, port)
+  on.exit(app_info$proc$kill(), add = TRUE)
+  remDr$navigate(app_info$url)
+  Sys.sleep(20)
+  # Wait for animint div to be present
+  animint_ready <- FALSE
+  for (i in 1:10) {
+    res <- remDr$Runtime$evaluate("document.querySelector('div#animint') !== null")
+    if (isTRUE(res$result$value)) {
+      animint_ready <- TRUE
+      break
+    }
+    Sys.sleep(0.1)
+  }
+  expect_true(animint_ready, info = "animint div should be present") 
+  # Check for rendered circles
+  circles <- remDr$Runtime$evaluate(
+    "document.querySelector('div#animint svg').querySelectorAll('circle').length"
+  )$result$value
+  expect_true(circles >= 1, info = "At least one circle should be rendered in div#animint svg")
+})
+test_that("WorldBank shiny app functionality", {
+  worldbank_dir <- file.path("inst", "examples", "shiny-WorldBank")
+  if (!dir.exists(worldbank_dir)) skip("WorldBank app directory not found")
+  if (file.path(worldbank_dir, "app.R") == file.path(tempdir(), "app.R")) {
+    skip("Tests skipped for mock app")
+  }
+  app_info <- start_app("shiny", worldbank_dir, port)
+  on.exit(app_info$proc$kill(), add = TRUE)
+  remDr$navigate(app_info$url)
+  Sys.sleep(20)
+  # Wait for animint div to be present
+  animint_ready <- FALSE
+  for (i in 1:10) {
+    res <- remDr$Runtime$evaluate("document.querySelector('div#animint') !== null")
+    if (isTRUE(res$result$value)) {
+      animint_ready <- TRUE
+      break
+    }
+    Sys.sleep(0.1)
+  }
+  expect_true(animint_ready, info = "animint div should be present")
+  # Check for rendered circles
+  circles <- remDr$Runtime$evaluate(
+    "document.querySelector('div#animint svg')?.querySelectorAll('circle').length || 0"
+  )$result$value
+  expect_true(circles >= 1, info = "At least one circle should be rendered")
+  get_year <- function() {
+    year <- remDr$Runtime$evaluate(
+      "var nodes = document.querySelectorAll('svg text'); var t = Array.from(nodes).find(n => n.textContent.includes('year = ')); t ? t.textContent.replace('year = ', '') : ''"
+    )$result$value
+    expect_true(nchar(year) > 0, info = "Year text should be present")
+    return(year)
+  }
+  old_year <- get_year()
+  Sys.sleep(10)
+  new_year <- get_year()
+  expect_true(old_year != new_year, info = "Year should change after animation")
+  div_left <- remDr$Runtime$evaluate(
+    "document.querySelector('#animint').getBoundingClientRect().left"
+  )$result$value
+  expect_true(is.numeric(div_left), info = "Div left position should be numeric")
+})
+test_that("animint plot renders in an interactive document", {
+  if (!requireNamespace("rmarkdown")) skip("Package 'rmarkdown' not installed")
+  rmd_file <- file.path("inst", "examples", "rmarkdown", "index.Rmd")
+  if (!file.exists(rmd_file)) skip("RMarkdown file not found")
+  app_info <- start_app("rmd", rmd_file, port)
+  on.exit(app_info$proc$kill(), add = TRUE)
+  remDr$navigate(app_info$url)
+  Sys.sleep(20)
+  iframe_ready <- FALSE
+  for (i in 1:10) {
+    res <- remDr$Runtime$evaluate("document.querySelector('.shiny-frame') !== null")
+    if (isTRUE(res$result$value)) {
+      iframe_ready <- TRUE
+      break
+    }
+    Sys.sleep(0.1)
+  }
+  expect_true(iframe_ready, info = "Shiny iframe should be present")
+  circles <- remDr$Runtime$evaluate(
+    "document.querySelector('.shiny-frame').contentDocument.querySelectorAll('svg circle').length"
+  )$result$value
+  if (circles == 0) {
+    animint_circles <- remDr$Runtime$evaluate(
+      "document.querySelector('.shiny-frame').contentDocument.querySelectorAll('div#animint svg circle').length"
+    )$result$value
+    circles <- animint_circles
+  }
+  expect_true(circles >= 1, info = "At least one circle should be rendered in iframe")
+})