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

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 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 an 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's empty. 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)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.