Rmarkdown 使用该行的下载按钮下载数据

Question

更新

renderdatatable 不显示操作按钮，renderDT 显示但无法下载表格，尽管我可以看到使用 cat 语句触发的操作按钮

---

我是 Markdown 新手，试图构建一个 Markdown 应用程序，该应用程序需要根据操作/下载按钮下载数据。在我下面的示例中，我喜欢有一个 downloadButton 或 downloadLink 来下载下载按钮行的行内容，如果我单击第一个操作按钮，那么我喜欢下载 mtcars 第一行值 mpg、cyl、disp 到 csv 或 excel。

我在实际应用程序中有一个相当大的子集，因此我可以进行相应的过滤。

问题是我没有得到操作按钮，而只是在 DT 中得到原始 html，不确定我是否遗漏了小细节。

    ---    
title: "Download data with download button"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(downloadthis)
library(dplyr)
```


```{r, echo=FALSE}

shinyInput <- function(FUN, n, id, ...) {
      vapply(seq_len(n), function(i){
        as.character(FUN(paste0(id, i), ...))
      }, character(1))
      
}

downloadButtonRmd <- function (outputId, label = "Download", class = NULL, ...)  {
     tags$a(id = outputId, class = paste("btn btn-default shiny-download-link", 
        class), href = "", target = "_blank", download = NA, 
        icon("download"), label, ...)
}

tab <- data.frame(head(mtcars[1:3]))
tab <- tab %>% mutate(
    dl1 = shinyInput(actionButton, nrow(.), 'button_', label = "Download", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
    dl2 = shinyInput(downloadButtonRmd, nrow(.), 'button_', label = "Download",onclick = 'Shiny.onInputChange(\"select_button1\", this.id)' ))
                 

# renderDataTable({
#   tab %>%
#     datatable(extensions = 'Buttons',
#             options = list(dom = 'Blfrtip',
#                            buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
#                            lengthMenu = list(c(10,25,50,-1),
#                                              c(10,25,50,"All"))))
#   })

renderDT({
  datatable(tab,
                  options = list(pageLength = 25,
                                 dom        = "rt"),
                  rownames = FALSE,
                  escape   = FALSE)})  


observeEvent(input$select_button1, {
selectedRow <<- as.numeric(strsplit(input$select_button1, "_")[[1]][2])
      cat(input$select_button1)
  
  downloadHandler(filename = "Academic Report.csv",
                  content = function(file) {write.csv(tab[selectedRow,1:3], file, row.names = FALSE)},
                  contentType = "text/csv")
})
```

我已经阅读了这些链接和许多其他链接，但我无法得到我想要的内容

RShiny Download Button Within RMarkdown
R Shiny: Handle Action Buttons in Data Table
谢谢

Answer 1

这是使用downloadthis包的方法。

---
title: "DT download row"
author: "Stéphane Laurent"
date: "21/03/2022"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(DT)
library(downloadthis)
htmltools::tagList( # for the icons
  rmarkdown::html_dependency_font_awesome()
)
```

```{r}
dat <- mtcars
dat[["Download"]] <- vapply(1L:nrow(mtcars), function(i){
  as.character(
    download_this(
      .data = mtcars[i, ],
      output_name = paste0("mtcars - row ", i),
      output_extension = ".csv",
      button_label = "Download",
      button_type = "primary",
      icon = "fa fa-save",
      csv2 = FALSE,
      self_contained = TRUE
    )
  )
}, character(1L))
```

```{r}
datatable(
  dat,
  escape = FALSE,
  options = list(
    columnDefs = list(
      list(targets = ncol(dat), orderable = FALSE),
      list(targets = "_all", className = "dt-center")
    )
  )
)
```

当然，如果您编辑表格，这将不起作用。