首页 > 解决方案 > 在 R 中下载 Shiny 中的绘图和表格;从 pickerInput 中选择的表/绘图中进行选择

问题描述

我想在我的 Shiny 应用程序中添加一个下载功能,用户可以在其中下载从pickerInput. 也许有一个更合适的替代方案比pickerInput它更容易,但这是我到目前为止的代码(使用mpg数据作为可重现的最小示例): -

#UI
ui<-fluidPage(
  tabPanel("Minimal Example",
           sidebarLayout(
             sidebarPanel(width = 4, 
                          
                          pickerInput("manufacturer", "Select manufacturer",
                                      choices = unique(mpg$manufacturer),options = list('actions-box'=TRUE, 'live-search'=TRUE), multiple = T),
                          pickerInput("model", "Select model",
                                      choices = unique(mpg$model),options = list('actions-box'=TRUE, 'live-search'=TRUE), multiple = T),
                          
                           pickerInput("eda_plotpick", "Select plot to save",
                                      choices = c("Scatter plot",
                                                 "Bar plot")),
                          pickerInput("eda_tablepick", "Select table to save",
                                      choices = c("mpg",
                                                  "mpg_filtered")),
                    
                          
                          actionButton("run_eda", "Run analysis"),
             downloadButton("downloadplot", "Download plot"),
           downloadButton("downloadtable", "Download table")),
             mainPanel(
       
               column(width = 8, box("Scatter plot", plotOutput("scatter"), width = "100%")),
               column(width = 8, box("Bar plot", plotOutput("bar"), width = "100%")),
               column(width = 8, box("mpg data", tableOutput("mpg"), width = "100%")),
               column(width = 8, box("mpg data (filtered)", tableOutput("mpg_filter"), width = "100%"))
              
             )          
             
           )
           
           
  )#end of tabpanel
  
)#end of fluidpage


#SERVER
server<-function(input,output,session){
  
  
  
  observeEvent(input$run_eda,{
   
    
    output$scatter<-renderPlot({
      
    scatterplot<-ggplot(mtcars, aes(x=wt, y=mpg)) + 
      geom_point(aes(size=qsec))
      return(scatterplot)
      
    })
    
    
    output$bar<-renderPlot({
      
      barplot<-ggplot(mpg,aes(y = class))+geom_bar()
      
      return(barplot)
      
    })
    
    
    output$mpg<-renderTable({
      
      
      return(mpg)
      
    })
    
    
    output$mpg_filter<-renderTable({
      
      
      
      mpg_filtered <- mpg %>%
        filter(manufacturer %in% input$manufacturer)%>%
        filter(model %in% input$model)
        
      
      
      
      return(mpg_filtered)
      
    })
    
    
    
    
    
  })#end of observe event
  
  
   output$downloadtable <- downloadHandler(
     filename = function() {
       paste('data-', input$eda_tablepick, '.csv', sep='')
     },
     content = function(con) {
       write.csv(data, con)
     }
   )
  
   
   output$downloadplot <- downloadHandler(
     filename = function() {
       paste('plot-', input$eda_plotpick,'.png', sep='')
     },
     content = function(con) {
       write.csv(data, con)
     }
   )
  
  
  
  
}#end of server


shinyApp(ui,server)

在这个例子中,用户有一个散点图和一个条形图。有两张桌子;完整的mpg数据集和过滤后的版本。

我的问题是,我缺少哪些附加代码将downloadHandler函数链接到它们各自的pickerInput函数,以便用户可以指定要下载到他们的机器的表或绘图?如果有更简单的方法(有或没有pickerInput)我会很高兴听到它:)

标签: rplotdplyrshinydownload

解决方案


这是一种方法:

#UI
ui<-fluidPage(
  tabPanel("Minimal Example",
           sidebarLayout(
             sidebarPanel(width = 4, 
                          
                          pickerInput("manufacturer", "Select manufacturer",
                                      choices = unique(mpg$manufacturer),options = list('actions-box'=TRUE, 'live-search'=TRUE), multiple = T),
                          pickerInput("model", "Select model",
                                      choices = unique(mpg$model),options = list('actions-box'=TRUE, 'live-search'=TRUE), multiple = T),
                          
                          pickerInput("eda_plotpick", "Select plot to save",
                                      choices = c("Scatterplot",
                                                  "Barplot")),
                          pickerInput("eda_tablepick", "Select table to save",
                                      choices = c("mpg",
                                                  "mpg_filtered")),
                          
                          
                          actionButton("run_eda", "Run analysis"),
                          downloadButton("downloadplot", "Download plot"),
                          downloadButton("downloadtable", "Download table")),
             mainPanel(
               
               column(width = 8, box("Selected plot", plotOutput("myplot"), width = "100%")),
               column(width = 8, box("Selected table", tableOutput("mytable"), width = "100%"))
               
             )          
             
           )
           
           
  )#end of tabpanel
  
)#end of fluidpage


#SERVER
server<-function(input,output,session){
  
  observeEvent(input$run_eda,{
  
  plot<- reactive({
    req(input$manufacturer,input$model)
    if (input$eda_plotpick=="Scatterplot"){
      plot<-ggplot(mtcars, aes(x=wt, y=mpg)) + geom_point(aes(size=qsec))
    }else plot<-ggplot(mpg,aes(y = class))+geom_bar()
    plot
  })
  output$myplot <- renderPlot({
    plot()
  })
  
  data <- reactive({
    req(input$manufacturer,input$model)
    if (input$eda_tablepick=="mpg_filtered"){
      data <- mpg %>%
        filter(manufacturer %in% input$manufacturer) %>%
        filter(model %in% input$model)
    }else data <- mpg
    data
  })
  output$mytable <- renderTable({
    data()
  })
  
  
  output$downloadtable <- downloadHandler(
    filename = function() {
      paste('data-', input$eda_tablepick, '.csv', sep='')
    },
    content = function(file) {
      write.csv(data(), file)
    }
  )
  
  output$downloadplot <- downloadHandler(
    filename = function() {
      paste('plot-', input$eda_plotpick,'.png', sep='')
    },
    content = function(con) {
      png(con, units = "px")
      print(plot())
      dev.off() 
    }, contentType = 'image/png'
  )
  
  })#end of observe event
  
}#end of server


shinyApp(ui,server)

推荐阅读