有没有办法在R Shiny的同一个下载按钮下同时下载csv和pdf文件?

1l5u6lss  于 2023-01-06  发布在  其他
关注(0)|答案(1)|浏览(156)

我做了一个简单的应用程序,我希望用户能够下载某些数据。我知道如何设置下载按钮,以包括csv文件,但我不知道如何在同一个按钮下包含pdf文件。我不想创建一个新的下载按钮只是pdf文件。这将是更方便的所有在一个按钮下提供。这个例子中的pdf文件是FRED的图表,显示了伊利诺斯州的GDP趋势。我不知道如何把它正式包含在这里。但是我下面的代码是我真正拥有的,正如你所看到的,full_data的csv文件工作得很好。
一如既往,我很感激任何帮助。谢谢。

library(tidyverse)
library(plotly)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)

full_data <- tibble(
  State = c("IL", "IL", "IL", "IL", "IL", "IL", "IN", "IN", "IN", "IN", "IN", "IN"),
  City = c("Chicago", "Rockford", "Naperville", "Chicago", "Rockford", "Naperville","Fort Wayne", 
           "Indianapolis", "Bloomington", "Fort Wayne", "Indianapolis", "Bloomington"),
  Year = c("2008", "2008", "2008", "2009", "2009", "2009", "2008", "2008", "2008", "2009", "2009", "2009"),
  GDP = c(200, 300, 350, 400, 450, 250, 600, 400, 300, 800, 520, 375)
)

ui <- fluidPage(
  useShinyjs(),
  selectInput(
    inputId = "year",
    label = "Year",
    multiple = TRUE,
    choices = unique(full_data$Year),
    selected = unique(full_data$Year)
  ),
  selectInput(
    inputId = "state",
    label = "State",
    choices = unique(full_data$State)
  ),
  selectInput(
    inputId = "dataset",
    label = "Select Data to Download",
    choices = c("Full Data",
                "Illinois Trends")
  ),
  downloadButton(outputId = "downloadData",
                 label = "Download"),
  plotlyOutput("gdp_level", height = 400),
  shinyjs::hidden(actionButton("clear", "Return to State"))
)

server <- function(input, output, session) {
  
  
  datasetInput <- reactive({
    switch(input$dataset,
           "Full Data" = full_data,
           "Illinois Trends" = "Data/illinois_graph.pdf")
  })
  
  
  output$downloadData <- downloadHandler(
    filename = function() {
      paste(input$dataset, ".csv", sep = "")
    },
    content = function(file) {
      write.csv(datasetInput(), file, row.names = FALSE)
    }
  )
  
  
  drills <- reactiveValues(category = NULL,
                           sub_category = NULL)
  
  
  gdp_reactive <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state)
  })
  
  
  gdp_reactive_2 <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state) %>%
      filter(City %in% drills$category)
  })
  
  
  gdp_data <- reactive({
    if (is.null(drills$category)) {
      return(gdp_reactive())
    }
    else {
      return(gdp_reactive_2())
    }
  })
  
  
  output$gdp_level <- renderPlotly({
    if (is.null(drills$category)) {
      plot_title <- paste0("GDP Level of ",  input$state)
    } else {
      plot_title <- paste0("GDP Level of ",  drills$category)
    }
    
    
    gdp_data() %>%
      plot_ly(
        x = ~ Year,
        y = ~ GDP,
        color = ~ City,
        key = ~ City,
        source = "gdp_level",
        type = "bar"
      ) %>%
      layout(
        barmode = "stack",
        showlegend = T,
        xaxis = list(title = "Year"),
        yaxis = list(title = "GDP"),
        title = plot_title
      )
  })
  
  
  observeEvent(event_data("plotly_click", source = "gdp_level"), {
    x <- event_data("plotly_click", source = "gdp_level")$key
    if (is.null(x))
      return(NULL)
    if (is.null(drills$category)) {
      drills$category <- unlist(x)
    }  else {
      drills$sub_category <- NULL
    }
  })
  
  
  observe({
    if (!is.null(drills$category)) {
      shinyjs::show("clear")
    }
  })
  
  
  observeEvent(c(input$clear, input$state), {
    drills$category <- NULL
    shinyjs::hide("clear")
  })
}

shinyApp(ui, server)
lmvvr0a8

lmvvr0a81#

您可以将可下载的文件存储在临时目录中,然后将其内容作为zip包交付:

server <- function(input, output) {
    ## helper functions to create some dummy PDF and CSV:
    store_sample_PDF <- function(file_name){
        pdf(file = file_name); plot(1); dev.off()
    }
    store_sample_CSV <- function(file_name) write.csv(iris, file = file_name)

    output$downloadData <- downloadHandler(
        contentType = 'application/zip',
        filename = function() paste0("data-", Sys.Date(), ".zip"),
        content = function(file) {
            ## set name for directory to be zipped:
            bundle_dir_name <- file.path(tempdir(),'bundle')
            ## create fresh zipping directory:
            if(dir.exists(bundle_dir_name)){
                unlink(bundle_dir_name, recursive = TRUE, force = TRUE)
            }
            dir.create(bundle_dir_name)

            ## replace the following with the real code:
            store_sample_PDF(file.path(bundle_dir_name, 'my_pdf.pdf'))
            store_sample_CSV(file.path(bundle_dir_name, 'my_csv.csv'))

            zip::zip(zipfile = file,
                     files = dir(bundle_dir_name, full.names = TRUE),
                     mode = 'cherry-pick'
                     )
        }
    )
}

参见示例here

相关问题