I created downloadlinks inside rows of a reactable
I did this for a DT::datatable() and a reactable::reactable()
I also created the respective output downloadHandlers using apply on the ids
For the DT it works , but for the reactable it does not.
Please note that the trick for the DT to work as I found out here, is the:
options = list(
# see https://stackoverflow.com/a/57978298/8689932
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
Can I do something similar for the reactable?
library(shiny)
library(reactable)
library(DT)
mtcars2 <- head(mtcars[1:3], 6)
ui <- fluidPage(
helpText("The buttons in this DT table work"),
DTOutput("tbl_DT"),
hr(),
helpText("The buttons in this reactable table do work"),
reactableOutput("tbl_reactable"),
)
server <- function(input, output, session) {
rv <- reactiveValues(
downLinks = NULL
)
observe({
ids <- seq_len(nrow(mtcars2))
rv$downLinks <- sprintf('<a id="down_%s" class="shiny-download-link" href="" target="_blank" download>Download</a>', ids)
# Create Outputs
lapply(ids, function(id){
output[[paste0("down_", id)]] <- downloadHandler(
filename = function(){
paste0("mtcars-from-button-", id, ".csv")
},
content = function(file){
write.csv(mtcars2, file)
}
)
})
})
output$tbl_reactable <- renderReactable({
tbl <- mtcars2
tbl$links <- rv$downLinks
reactable(tbl,
columns = list(
links = colDef(html = TRUE)
)
)
})
output$tbl_DT <- renderDT({
tbl <- mtcars2
tbl$links <- rv$downLinks
datatable(tbl,
escape = FALSE, selection = "none",
options = list(
# This is important for the DownloadLink s towork
# see https://stackoverflow.com/a/57978298/8689932
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})
}
shinyApp(ui, server)
Playing around with this a bit, I found a way that involves using the session object's function registerDownload() to get an href for each link.
Note that this seems to work in a completely different way than the DT code. I don't really know enough to say if there are tradeoffs. To me it looks cleaner, but I may be missing something.
library(shiny)
library(reactable)
mtcars2 <- head(mtcars[1:3], 6)
ui <- fluidPage(
reactableOutput("tbl_reactable"),
)
server <- function(input, output, session) {
rv <- reactiveValues(
downLinks = NULL
)
observe({
ids <- seq_len(nrow(mtcars2))
# ---- MODIFICATIONS TO MAKE DOWNLOADS WORK IN THIS BLOCK ----
# Need to add the href to the HTML by using `session$registerDownload`
rv$downLinks <- sprintf(
'<a id="down_%s" class="shiny-download-link" href="%s" target="_blank" download>Download</a>',
ids,
vapply(ids, FUN.VALUE = character(1), function(id) {
# `name` matches id in HTML (and name of output object you
# used to assign downloadHandler to)
# `filename` is just like downloadHandler's filename
# `contentType` is the same as downloadHandler's
# contentType but doesn't have NULL as default
# `func` is equivalent to downloadHandler's content (a
# function that takes file as parameter and saves to it)
session$registerDownload(
name = paste0("down_", id),
filename = function() { paste0("mtcars-from-button-", id, ".csv") },
contentType = NULL,
func = function(file) {
write.csv(mtcars2, file)
}
)
})
)
# -------------------------------------------------------------
})
output$tbl_reactable <- renderReactable({
tbl <- mtcars2
tbl$links <- rv$downLinks
reactable(tbl,
columns = list(
links = colDef(html = TRUE)
)
)
})
}
shinyApp(ui, server)