【发布时间】：2020-10-28 04:31:28
【问题描述】：
我正在寻找有关在我的应用程序中有一个下载按钮的信息，该按钮将各种文件拉入一个 zip 存档。
我的应用程序显示时间线和数据表，并且将包含与数据表上的条目相关联的文件。这些文件将存储在应用程序的一个目录中，并且我将在数据表中有一列文件名。
我的想法是，当我单击下载按钮时，将创建一个 zip 存档，其中包含我指向的几个标准文件、数据表的 csv、时间线的 png 以及我拥有的任何文件与数据表的选定条目相关联。
我还没有开始处理与数据表相关的文件，但这是我的最终状态。
当前代码
library(shiny)
library(timevis)
library(lubridate)
library(dplyr)
starthour <- 8
today <- as.character(Sys.Date())
todayzero <- paste(today,"00:00:00")
todayAM <- paste(today,"07:00:00")
todayPM <- paste(today, "18:00:00")
items <- data.frame(
category = c("Room","IceBreaker","Activity","Break"),
group=c(1,2,3,4),
className = c ("red_point", "blue_point", "green_point","purple_point"),
content = c("Big Room","Introductions","Red Rover","Lunch"),
length = c(480,60,120,90)
)
groups <- data.frame(id= items$group, content = items$category)
data <- items %>% mutate(id = 1:4,
start = as.POSIXct(todayzero) + hours(starthour),
end = as.POSIXct(todayzero) + hours(starthour) + minutes(items$length)
)
js <- "
$(document).ready(function(){
$('#download').on('click', function(){
domtoimage.toPng(document.getElementById('appts'), {bgcolor: 'white'})
.then(function (dataUrl) {
var link = document.createElement('a');
link.download = 'my-timeline.png';
link.href = dataUrl;
link.click();
});
});
});"
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
tags$script(src = "myJS.js"),
tags$style(HTML("
.red_point { border-color: red; border-width: 2px; }
.blue_point { border-color: blue; border-width: 2px; }
.green_point { border-color: green; border-width: 2px; }
.purple_point { border-color: purple; border-width: 2px; }
"))),
timevisOutput("appts"),
div("Selected items:", textOutput("selected", inline = TRUE)),
div("Visible window:", textOutput("window", inline = TRUE)),
tableOutput("table"),
actionButton("download", "Download timeline", class = "btn-success")
)
server <- function(input, output) {
output$appts <- renderTimevis(
timevis(
data = data,
groups = groups,
fit = TRUE,
options = list(editable = TRUE, multiselect = TRUE, align = "center", stack = TRUE,start = todayAM,
end = todayPM,showCurrentTime = FALSE,showMajorLabels=FALSE)
)
)
output$selected <- renderText(
paste(input$appts_selected, collapse = " ")
)
output$window <- renderText(
paste(input$appts_window[1], "to", input$appts_window[2])
)
output$table <- renderTable(
input$appts_data
)
}
shinyApp(ui, server)
编辑
这是我当前如何从我的生产应用程序的数据表中下载选定的行。
output$downloadData2 <- downloadHandler(
filename = function() {paste('Selected Retreat Options', Sys.Date(), '.csv', sep = '')},
content = function(file){ write.csv(thedata()[input[["tbl1_rows_selected"]], ],file)})
【问题讨论】：
标签： javascript r shiny