adding namespace to Javascript in Shiny modules

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

In case others run into this problem, the fix was to include session$ns in the id of the call to shinyInputOther. Using the included example, that looks like:

rating = shinyInputOther(
  FUN = selectInput,
  len = nrow(mtcarsReactive()),
  id = paste0(session$ns('rating_')),
  choices=c("high", "med", "low"),
  width = "60px")

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.