Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

R Shiny downloadHandler returns app html rather than plots or data

I'm simply looking to return a user-produced plot (built in ggplot) or a data table from an app built from modules and a plotting helper function. I've seen many posts about downloadHandler being very finicky and there even appears to be open issues with some of downloadHandler's behaviours. The odd behaviour I'm getting, which I haven't seen posts about, is that it returns an html page of my app instead of the plot, regardless of how I try to save the plot (i.e., using pdf/png devices, ggsave(), etc.), or whether I use suspendWhenHidden. I can run the plot saving code external to Shiny and it works fine. I'm running all of this from the browser (Firefox, though Chrome does the same) on a mac, with recently updated everything. Example code below.

Modules:

library(shiny)
library(ggplot2)
# UI module
modUI <- function(id, label="inputvalues") {
  ns <- NS(id)
  tagList(
    numericInput(ns("mean"), "Mean",value = NULL),
    numericInput(ns("sd"),"Std. Dev.",value = NULL),
    actionButton(ns("draw"),"Draw plot"),
    downloadButton(ns("dlPlot"), "Download Plot")
  )
}

# Server Logic module
mod <- function(input, output, session) {
  x <- reactiveValues(data=NULL)
  observeEvent(input$draw, {
    x$data <- rnorm(100,input$mean,input$sd)
  })

  return(list(dat = reactive({x$data}),
          m = reactive({input$mean}),
          s = reactive({input$sd})
          )
     )
}

Plotting helper function:

showPlot <- function(data, m, s) {
  d <- data.frame(data)
  p <- ggplot(d, aes(x=d, y=d)) +
    geom_point() +
    geom_vline(xintercept=m)
  p
}

UI and Server calls:

ui <- navbarPage("Fancy Title",id = "tabs",
                 tabPanel("Panel1",value = 1,
                          sidebarPanel(
                            modUI("input1")
                          ),
                          mainPanel(plotOutput("plot1"))
                 )
)

server <- function(input, output, session) {
  y <- callModule(mod, "input1")
  output$plot1 <- renderPlot({ 
    if (is.null(y$dat())) return()
    showPlot(data.frame(y$dat()), y$m(), y$s())
  })

  output$dlPlot <- downloadHandler(
    filename="~Plot_Download.pdf",
    content=function(file){
      pdf(filename, file)
      p
      dev.off()
    }
  )
}

shinyApp(ui, server)

Thanks as always for any help!

like image 902
phalteman Avatar asked Jan 24 '18 21:01

phalteman


1 Answers

Finally figured out an answer to this, based in large part on this post. The answer is to create a server module specifically for the download (which can take the session and namespace info), and then to call that module in the server. Additional and updated code below:

The new download module:

dlmodule <- function(input, output, session) {
  output$dlPlot <- downloadHandler(
    filename="Plot_Download.pdf",
    content=function(file){
      ggsave(file, device = pdf, width = 7,height = 5,units = "in",dpi = 200)
    }
  )
}

The updated server call:

server <- function(input, output, session) {
  y <- callModule(mod, "input1")
  output$plot1 <- renderPlot({
    if (is.null(y$dat())) return()
    showPlot(data.frame(y$dat()), y$m(), y$s())
  })

  dl.y <- callModule(dlmodule, "input1")
}

Everything else stays the same.

like image 101
phalteman Avatar answered Nov 17 '22 06:11

phalteman