shiny tests using chromote

.github/workflows/tests.yaml

@@ -12,7 +12,7 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        test-suite: [ renderer, compiler, CRAN ]
+        test-suite: [ renderer, compiler, CRAN, shiny]
 
     name: Test Suite ${{ matrix.test-suite }}
     env: 
@@ -54,13 +54,16 @@ jobs:
         run: |
           if [ "$TEST_SUITE" == "CRAN" ]; then
             bash build.sh
+          elif [ "$TEST_SUITE" == "shiny" ]; then
+            Rscript -e "library(animint2); testthat::test_file('tests/testthat/test-shiny.R')"
           elif [ "$TEST_SUITE" == "compiler" ]; then
             Rscript -e "source('tests/testthat.R', chdir = TRUE)"
             Rscript -e 'covr::codecov(quiet = TRUE)'
           else
             Rscript -e "source('tests/testthat.R', chdir = TRUE)"
           fi
 
+
       - name: Convert JS coverage to Istanbul format
         if: matrix.test-suite == 'renderer'
         run: |
@@ -82,4 +85,4 @@ jobs:
           else
             echo "No coverage file found"
             exit 1
-          fi
+          fi

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")
@@ -142,4 +141,3 @@ html_dependency_plotJSON <- function(path, fileName) {
                  src = path,
                  script = fileName)
 }
-

inst/examples/rmarkdown/index.Rmd

@@ -8,9 +8,13 @@ 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)
 )
 ```
@@ -62,6 +66,7 @@ scatter <- scatter + theme_animint(width = 360, height = 360)
 In this example, the plot aesthetics are fixed, but we could integrate shiny's reactive components into animint's options such as the animation speed. 
 
 ```{r reactives}
+
 getPlotList <- reactive({
   # think of animint objects as a list of ggplots and specially named options
   list(# the plots we constructed earlier
@@ -90,4 +95,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,56 @@
 library(shiny)
 library(animint2)
+library(maps)  # Add this line
 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 +62,8 @@ 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")  # Add MAP function
+
     y.na <- WorldBank[[input$y]]
     x.na <- WorldBank[[input$x]]
     not.na <- WorldBank[!(is.na(y.na) | is.na(x.na)),]
@@ -37,6 +82,18 @@ 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,11 +168,22 @@ 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)),
           showSelected="year",
           data=SCATTER(years))
+
       if(is.discrete(not.na[[input$size]])){
         gg <- gg+scale_size_discrete()
       }else{
@@ -134,4 +202,4 @@ shinyServer(function(input, output) {
     getViz()
   })
 
-})
+})

inst/examples/shiny/server.R

@@ -1,6 +1,7 @@
 library(shiny)
 library(animint2)
 
+
 shinyServer(function(input, output) {
 
   getPlot <- reactive({

tests/testthat/helper-functions.R

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