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

Rmarkdown Download data with download button for that row

更新

renderdatatable 不显示 actionbutton,renderDT 显示但不能只下载 table 虽然我可以看到 actionbutton 被 cat 语句触发


我是 markdown 的新手,我试图构建一个需要根据 action/download 按钮下载数据的 markdown 应用程序。在我下面的示例中,id 喜欢有一个 downloadButton 或 downloadLink 来下载下载按钮行的行内容,如果我单击第一个操作按钮然后 id 喜欢下载 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")
})
```

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



谢谢

这是使用 下载这个 包的方法。

---
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")
    )
  )
)
```

当然,如果您编辑 table,那将不起作用。