Dear Friends,
I use in my shiny apps custom shinyInput functions that facilitate building dynamic tables such that users can provide input from checkboxes, drop downs, text boxes, etc. to each row of a table. This functionality relies on calling Javascript in the UI and when generating output from DT::renderDataTable. This all works perfectly well when I use this tooling in the main app.R but I cannot get it to work when placed in a module. The problem surely is that I need to include the namespace in the calls to the Javascript when in the module but I do not know how to do this. I am working with some very large apps that I would very much like to modularize but need to nail this problem first. Could someone please suggest where I might add namespacing to the Javascript in the module? I have included excerpts from a toy example based on a subset of the mtcars dataset demonstrating the shinyInput functions and where I call Javascript in app.R - where would I add namespacing to this code to work properly in a module?
Thanks in advance for any assistance.
Kind regards,
Stevan
# UI
ui <- navbarPage("mtcars",
# app tab
tabPanel("app",
fluidPage(
DT::dataTableOutput("mtcarsOutput"),
tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) {
Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
})")),
DT::dataTableOutput("mtcarsWithRatingOutput")
) # close the page
), # close tab
# module tab
tabPanel("module",
moduleUI("mtcarsModule")
) # close tab
) # close navbarPage
# SERVER
# helper function to add interactive elements to rows of a table
shinyInputOther <- function(FUN, len, id, ...) {
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}
# helper function to extract interactive elements from rows of a table
shinyValue <- function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
# reactive data
mtcarsReactive <- reactive({
head(mtcars)
}) # close reactive
# reactive data output - allows adding a rating to each row/car
output$mtcarsOutput <- DT::renderDataTable({
mtcarsReactive() %>%
mutate(
rating = shinyInputOther(FUN = selectInput,
len = nrow(mtcarsReactive()),
id = 'rating_',
choices=c("high", "med", "low"),
width = "60px")
)
},
selection = 'none',
escape = FALSE,
server = FALSE,
options = list(bFilter = 0,
bLengthChange = F,
bPaginate = F,
bSort = F,
preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() {
Shiny.bindAll(this.api().table().node()); } ')
),
rownames = F) # close output
# reactive data with added rating for each row/car
mtcarsWithRating <- reactive({
mtcarsReactive() %>%
mutate(
rating = shinyValue("rating_",
nrow(mtcarsReactive())
)
)
}) # close reactive
# reactive data output - includes rating for each row/car
output$mtcarsWithRatingOutput <- DT::renderDataTable({
mtcarsWithRating()
},
selection = 'none',
escape = FALSE,
server = FALSE,
options = list(bFilter = 0,
bLengthChange = F,
bPaginate = F,
bSort = F
),
rownames = F) # close output