r - 如何从 Shiny 中的自定义按钮触发下载处理程序
问题描述
我有一个闪亮的应用程序。该应用程序包含一个表格。表格中的每一行都包含一个按钮,该按钮应允许用户将该行中的数据下载到报告中。
我只是坚持能够将自定义行按钮连接到下载处理程序。通常我会使用下载按钮来执行此操作,但我如何使用自定义按钮来执行此操作。
我的观察事件:
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"letter")
{
row_to_report=as.numeric(gsub("letter_","",input$lastClickId))
MyLetter=RV4$data[row_to_report,]
如何使用 downloadHandler 在此处触发下载:
downloadHandler(
filename = "letter.docx",
content = function(file) {
tempReport <- file.path(tempdir(), "letter.Rmd")
file.copy("letter.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(MyLetter)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv()),
)
}
)
}
else if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
RV3$data=RV3$data[-row_to_del,]
}
}
)
我的数据表是这样创建的:
output$drilldownBarr <- DT::renderDT({
if (!is.null(drilldataBarrd())) {
browser()
drilldataBarrdf<-drilldataBarrd()
drilldataBarrdf$Actions<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary letter" id=letter_',1:nrow(drilldataBarrd()),'>Letter</button>
</div>
')
}
datatable(drilldataBarrdf,escape=F, extensions = c("Select","Buttons"), selection = "none",
options = list(
scrollX = TRUE,
scrollY = TRUE,
pageLength = 200,
select = "api",
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print','colvis'))
)
})
也许有更好的方法?例如在每一行中创建一个下载按钮。但是如何做到这一点?
解决方案
这是使用报告文件的 base64 编码的解决方案。它不使用downloadHandler
.
library(shiny)
library(DT)
library(base64enc)
library(rmarkdown)
js <- '
Shiny.addCustomMessageHandler("download", function(b64){
const a = document.createElement("a");
document.body.append(a);
a.download = "report.docx";
a.href = b64;
a.click();
a.remove();
})
'
buttonHTML <- function(i){
as.character(
actionButton(
paste0("button_", i), label = "Report",
onclick = sprintf("Shiny.setInputValue('button', %d);", i)
)
)
}
dat <- iris[1:5,]
dat$Action <- sapply(1:nrow(dat), buttonHTML)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(dat, escape = -ncol(dat)-1)
})
observeEvent(input[["button"]], {
showNotification("Creating report...", type = "message")
tmpReport <- tempfile(fileext = ".Rmd")
file.copy("report.Rmd", tmpReport)
outfile <- file.path(tempdir(), "report.docx")
render(tmpReport, output_file = outfile,
params = list(data = dat[input[["button"]], -ncol(dat)]))
b64 <- dataURI(
file = outfile,
mime = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
)
session$sendCustomMessage("download", b64)
})
}
shinyApp(ui, server)
rmarkdown
文件report.Rmd:_
---
title: "Untitled"
author: "Stéphane Laurent"
date: "16 avril 2020"
output: word_document
params:
data: "x"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
params$data
```
推荐阅读
- python - 如何遍历字典中的键并匹配另一个字典中的键/值
- c - 更改值但打印时没有分段错误
- python - 使用熊猫双重连接列
- sql - 我该如何解决状态:失败 - 测试失败:IO 错误:网络适配器无法建立连接
- angularjs - 如何在 ng-repeat 行的选择选项(下拉框)中显示默认选项?
- hevc - Rigaya 的 NVEnc 对没有视频或音轨的文件进行编码
- python - SelectField:为什么返回“不是有效的选择错误”?
- xamarin - Xam.Plugin.Geolocator 在首次运行 iOS 14 时永远不会返回
- arduino - 暂停一个循环以在 Arduino 中运行另一个循环
- python - 使用带有 tqdm 进度条的 pafy 模块下载 YouTube 视频