当情节是反应性的时,如何下载闪亮的情节

时间:2019-04-08 16:35:13

标签: r plot shiny shiny-server shiny-reactivity

我有一个模块化的闪亮应用程序,它允许用户过滤一些数据,然后绘制结果。我正在尝试创建一个模块,该模块允许用户随后下载图,但始终出现错误。我认为该错误与情节反应有关,但无法弄清楚该如何解决。

玩具应用程序:

library(shiny)
library(tidyverse)

# generate some data
randData <- data.frame(col1 = sample(letters,100,replace = T), col2 = runif(100))

# shiny modules
col1Filter <-function(input, output, session, data){
  output$chooser <- renderUI({
    ns <- session$ns
    selectInput(inputId = ns("chosen"),
                label = 'Col 1',
                choices = sort(unique(data$col1)),
                multiple = TRUE)
  })
  return(reactive(input$chosen))
}
col1FilterUI <- function(id){
  ns <- NS(id)
  uiOutput(ns('chooser'))
}

filterTable <- function(input, output, session, data, col1Fetcher){
  return(reactive(data %>% filter(col1 %in% col1Fetcher())))
}

displayTable <- function(input, output, session, data){
  output$displayer <- DT::renderDataTable(data())
}
displayTableUI <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('displayer'))
}

displayPlot <- function(input, output, session, data){
  output$plot <- renderPlot({
    ggplot(data(), aes(col1,col2))+
      geom_boxplot()+
      theme_light()
  })
}
displayPlotUI <- function(id){
  ns <- NS(id)
  tagList(
    plotOutput(ns("plot")))
}

plotDownload <- function(input, output, session, plot) {
  output$downloadPlot <- downloadHandler(
    filename = function() {
      paste('plot_', Sys.Date(), '.png', sep='')
    },
    content = function(file) {
      png(file)
      plot()
      dev.off()
    }
  )
}
plotDownloadUI <- function(id) {
  ns <- NS(id)
  downloadButton(ns("downloadPlot"), label = 'Download plot')
}

# app

server <- function(input,output,session){

  chosenCol1 <- callModule(col1Filter,
                           id = 'col1Filter',
                           data = randData)
  filterTable <- callModule(filterTable,
                      id = 'filterTable',
                      data = randData,
                      col1Fetcher = chosenCol1)
  callModule(displayTable,
                      id = 'displayTable',
                      data = filterTable)
  plot <- callModule(displayPlot,
                     id = 'dispPlot',
                     data = filterTable)
  plotDownload <- callModule(plotDownload,
                             id = 'downPlot',
                             plot = plot)
}

ui <-   fluidPage(
  sidebarPanel(col1FilterUI('col1Filter')),
  mainPanel(
    tabsetPanel(
      tabPanel('data', value = 1,
               displayTableUI('displayTable')),
      tabPanel('plot', value = 1,
               displayPlotUI('dispPlot'),
               plotDownloadUI('downPlot')))
    )
  )


shinyApp(ui = ui, server = server)

0 个答案:

没有答案