【问题标题】:Download plots and tables in Shiny in R; Choosing from selection of tables/plots in pickerInput在 R 中下载 Shiny 中的绘图和表格;从 pickerInput 中选择的表/绘图中进行选择
【发布时间】:2021-05-01 09:32:49
【问题描述】:

我想在我的 Shiny 应用程序中添加一个下载功能,用户可以下载pickerInput 指定的表格(csv)或绘图(png)。也许有比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)我会很高兴听到它:)

【问题讨论】:

    标签: r plot dplyr shiny download


    【解决方案1】:

    这是一种方法:

    #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)
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2023-04-06
      • 2018-12-20
      • 2018-05-30
      • 1970-01-01
      • 2017-02-17
      相关资源
      最近更新 更多