Shiny app to generate and save a 3d interactive html plot

Question

I am trying to turn a functioning R script that generates a number of graphs into a shiny app. I am having issues with generating/saving 3D plots with the rgl package.

I tried including a reprex Shiny app below. What I'd like to be able to do is:

1. select the folder where I want to save my 3d graph
2. run the app only after I hit an action button
3. correctly save my interactive 3D .html file in such folder, which I can then open and interact with in my web browser (i.e. rotation, zoom in, zoom out)

The code below does generate an .html file in the desired folder, but it looks empty when I open it. Not exactly sure why that is, especially considering that when the app is run the correct 3D plot is generated in a pop up window as an RGL device.

# Libraries ---------------------------------------------------------------

library(shiny)
library('shinyDirectoryInput')
library(tidyverse)
library(rgl)


# START: UI ---------------------------------------------------------------

ui <- fluidPage(
  titlePanel(
    strong("Data Analysis App")
  ),
  
  sidebarLayout(
    sidebarPanel(
      h3(em("Save Analysis")),
      directoryInput('directory', label = 'select a folder to save files in'),
      h3(em("Run Analysis")),
      br(),
      actionButton("run_button", label = "Run")
    ),
    
    
    mainPanel(
      h1("Instructions"),
      br(),
      p("1) Select directory to save the 3D graph in"),
      br(),
      p("2) Hit the \"Run\" button")
    )
  )
)


# START: Server -----------------------------------------------------------

server <- function(input, output, session) {
  
  ## select folder as wd, where analysis results will be saved
  observeEvent(
    ignoreNULL = TRUE,
    eventExpr = {
      input$directory
    },
    handlerExpr = {
      if (input$directory > 0) {
        # condition prevents handler execution on initial app launch
        
        # launch the directory selection dialog with initial path read from the widget
        selected_directory <- choose.dir(default = readDirectoryInput(session, 'directory'))
        
        # update the widget value
        updateDirectoryInput(session, 'directory', value = selected_directory)
      }
    }
  )
  
  observeEvent(input$run_button, {
    file_path <- str_c(readDirectoryInput(session, 'directory'), "/test.html")
    
    open3d()
    
    plot3d(x = iris$Sepal.Length,
           y = iris$Sepal.Width,
           z = iris$Petal.Length)
    
    htmlwidgets::saveWidget(rglwidget(width = 800, height = 800),
                            file = file_path,
                            libdir = "HTML-dependencies",
                            selfcontained = FALSE
    )
    
  })
}

shinyApp(ui = ui, server = server)

Answer 1

The problem here is that the way rglwidget() output is handled is different in different circumstances, and calling saveWidget() from a Shiny app confused rgl: it thought it was in a Shiny display and set things up assuming rglwidgetOutput() had been called, but it hadn't been called since you were saving to a file.

So this is a bug, and it needs to be fixed to do what you want. Alternatively, you can use an older version of rgl (before 1.1.4 should be fine). It won't offer "alt" text for screen readers, but for most users that's okay.

A workaround would be to add alt text manually (it doesn't matter to the code what it says, but for your screen reader users it should be a short description of what is in the plot). Unfortunately it needs to have a specific ID to match the ID of the rgl display, and I don't think it's easy to get that: it is produced internally by saveWidget() and so your code won't see it.

EDITED to add:

Version 1.2.3 of rgl, available using

remotes::install_github("dmurdoch/rgl")

should fix this bug.