从Shiny App的downloadHandler中获取正确的输入值,以便在下载文件名中显示rmarkdown word doc

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

我构建了一个Shiny应用程序,我的客户希望能够将其部分内容下载到Word文档。使用here列出的步骤(对每个this post的示例代码进行了更正),我有一个可以工作的下载按钮,我想生成一个标准的文件名,其中包括报告主题的名称,而不是"reportiderdocx"这样的通用默认文件名,从Shiny应用程序UI的下拉列表中选择输入值。这看起来应该很简单,我已经非常接近了:我可以让文件名包含该输入选择的默认值,但当用户做出新选择时,我无法让它正确更新。
下面的代码是一个简化的示例,说明了我所需要的并生成了我所遇到的问题:
数据:

cities <- c("Atlanta", "Boston", "Chicago", "Detroit")

values <- c(100, 200, 300, 400)

test_df <- cbind.data.frame(cities, values)

saveRDS(test_df, file = "C:/Repos/Test Report Name/app/test_df.rds")

用户界面:

library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(shinyWidgets)
library(reactable)

ui <- fluidPage(
  
  mainPanel(
    fluidRow(
      selectInput('test',
                  label = 'Test',
                  choices = sort(unique(test_df$cities)),
                  multiple = FALSE,
                  selected = sort(unique(test_df$cities))[1])
            ),
    fluidRow(
      reactableOutput("data")
            ),
    fluidRow(
      downloadButton("report", "Generate Report")
    )
          )
              )

服务器:

library(tidyverse)
library(reactable)
library(shinyWidgets)

server <- function(input, output) {
  
  output$data <- renderReactable({
    
    x <- test_df %>%
      dplyr::filter(cities %in% input$test)
    
    reactable(x) 
    
  })
  
  output$report <- downloadHandler(
    
    # For PDF output, change this to "report.pdf"
    filename = paste(input$test, "Summary", Sys.Date(), ".docx"),   ### This paste function is the crucial part; I get the default value (Atlanta) no matter which option I select. 
    content = function(file) {
      # Copy the report file to a temporary directory before processing it, in
      # case we don't have write permissions to the current working dir (which
      # can happen when deployed).
      tempReport <- file.path(tempdir(), "report.Rmd")
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      
      # Set up parameters to pass to Rmd document
      params <- list(selection = input$test)
      
      # Knit the document, passing in the `params` list, and eval it in a
      # child of the global environment (this isolates the code in the document
      # from the code in this app).
      output <- rmarkdown::render(input = tempReport,
                                  params = params,
                                  envir = new.env(parent = globalenv())
      )
      file.copy(output, file)
      
    }
  )
  
  
}

降价文件:

---
title: "`r params$selection` Report"
output: word_document
params:
  selection: NA
---

```{r}

library(tidyverse)

x <- test_df %>%
      filter(cities %in% params$selection)

print(x)

所以,我运行这个,一切正常,除了文件名。我选择波士顿在下拉菜单中,我得到了波士顿在标题和波士顿数据在表中的markdown文件,但该文件仍然被称为"Atlanta Summary 1 - 3 - 2023. docx"。我已经尝试在服务器文件中创建新的变量,只接受`input$test`值,如下所示:

print_input_name <- reactive({

x <- input$test

x
})

Error in as.vector: cannot coerce type 'closure' to vector of type 'character'

print_input_name <- eventReactive({

x <- input$test

x

})

Error in is_quosure(expr) : argument "expr" is missing, with no default


我试着 Package 所有的downloadHandler()语句,但也不起作用。我还尝试直接在输入后命名对象(`x <- input$test`)并将对象输出命名为$x,但那也不起作用。我也试着像在RMD文件中那样叫它`params$selection`,但显然不起作用。所以我我被如何将输入选择存储为服务器中的一个对象而难住了。感谢任何帮助,我对Shiny相当陌生,仍在学习React元件的来龙去脉。
xsuvu9jc

xsuvu9jc1#

根据文档(?downloadHandler),filename参数应为
文件名的字符串,[...];或 * 返回此类字符串的函数 *。(可从此函数使用React值和函数。
因此,要解决您的问题,请使用

filename = function() paste(input$test, "Summary", Sys.Date(), ".docx")

另请参见文档的示例部分。
完整的可重现代码:

cities <- c("Atlanta", "Boston", "Chicago", "Detroit")
values <- c(100, 200, 300, 400)
test_df <- data.frame(cities, values)

library(shiny)
library(reactable)
library(tidyverse)

ui <- fluidPage(
  mainPanel(
    fluidRow(
      selectInput("test",
        label = "Test",
        choices = sort(unique(test_df$cities)),
        multiple = FALSE,
        selected = sort(unique(test_df$cities))[1]
      )
    ),
    fluidRow(
      reactableOutput("data")
    ),
    fluidRow(
      downloadButton("report", "Generate Report")
    )
  )
)

server <- function(input, output) {
  output$data <- renderReactable({
    x <- test_df %>%
      dplyr::filter(cities %in% input$test)

    reactable(x)
  })

  output$report <- downloadHandler(
    filename = function() paste(input$test, "Summary", Sys.Date(), ".docx"),
    content = function(file) {
      tempReport <- file.path(tempdir(), "report.Rmd")
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      params <- list(selection = input$test)
      output <- rmarkdown::render(
        input = tempReport,
        params = params,
        envir = new.env(parent = globalenv())
      )
      file.copy(output, file)
    }
  )
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:3354

相关问题