javascriptrshinyshinymodules

How to trigger a modalwindow with a click event using shiny.setInputValue inside a module


My app triggers a modalwindow when a row inside a reactable table is clicked. It works fine with no modules, but when I used modules it doesn't.

I search for a solution and tried many variations with no success. (I found some similar questions, but none with a working solution for my problem).

First a working example with no modules:

if (interactive()) {
library(shiny)
library(reactable)

n = c(2, 3, 5) 
s = c("aa", "bb", "cc") 
b = c(TRUE, FALSE, TRUE) 
dframe = data.frame(n, s, b) 

shinyApp(
ui <- fillPage(
reactableOutput("table")
),

server <- function(input,output,session){
output$table <- renderReactable(
  reactable(dframe,
            compact = T,
            rowStyle = list(cursor = "pointer"),
            defaultColDef = colDef(align = "left", maxWidth = 60),
            onClick = JS("function(rowInfo) {
                        Shiny.setInputValue('name', {id:rowInfo.id})
                        }"),
  )
)
observeEvent(input$name, {
  row_nr <- as.numeric(input$name$id)+1
  showModal( modalDialog( title = dframe$s[row_nr]))
})
})}

The same app with modules:

library(shiny)
library(reactable)

n = c(2, 3, 5) 
s = c("aa", "bb", "cc") 
b = c(TRUE, FALSE, TRUE) 
dframe = data.frame(n, s, b) 


tUI <- function(idd){
  ns <- NS(idd)
  tagList(
    reactableOutput(ns("table"))
  )
}

tServer <- function(idd, d){
  moduleServer(idd,
               function(input, output, session){
                 output$table <- renderReactable(
                   reactable(d,
                             compact = T,
                             rowStyle = list(cursor = "pointer"),
                             defaultColDef = colDef(align = "left", maxWidth = 60),
                             onClick = JS("function(rowInfo) {
                          Shiny.setInputValue('idd-name', {id:rowInfo.id})
                          }"),
                   )
                 )
                 observeEvent(input$"idd-name", {
                   row_nr <- as.numeric(input$name$id)+1
                   showModal( modalDialog( title = dframe$s[row_nr]))
                 })
  })}

ui <- fillPage(
  tUI("tt")
)
server <- function(input,output,session){
  ttt <- tServer("tt", d = dframe)
}
shinyApp(ui,server)

(I called the namespace "idd" so there was no conflict with {id:rowInfo.id} - don't know if it makes any difference...)

I tried the following combinations:

(from https://community.rstudio.com/t/shiny-setinputvalue-in-modular-app-with-namespaces/23263):

Shiny.setInputValue('idd-name', ... observeEvent(input$name ...

(from How to use shiny.setInputValue within a module?):

Shiny.setInputValue('idd-name', ... observeEvent(input$name ...

Shiny.setInputValue('",idd,"-name', observeEvent(input$name ...

I tried I don't know how many combinations but with no success. Probably the solution is quite simple... Can someone help?

Thanks, António


Solution

  • Here is a partial solution. I'm not familiar with reactable so can't sort out the final wrinkle...

    Your problem is that whilst Shiny knows about modules, JavaScript and the rest of R don't. So you have to take care when writing your JavaScript.

    You also have a couple of syntax errors in your observeEvent. Let's put those right first.

          observeEvent(
            input[["idd-name"]], {
              row_nr <- as.numeric(input[["idd-name"]])+1
              showModal( modalDialog(title = dframe$s[row_nr]))
            }
          )
    

    Note the use of [[]] rather than $ to access elements of Shiny's input array. Doing this allows the module to handle the namspacing for you. Also, I've corrected your definition of row_nr. This allows the title of the modal to be set correctly.

    Now we need to handle the namespacing issue for Javascript. First, put the definition of the JS function into a variable, and use paste0 to manually handle the name spacing.

    ns <- session$ns
    jsCode <- paste0(
      "function(rowInfo) { Shiny.setInputValue('", 
      ns("idd-name"), 
      "', 
      {id:rowInfo.id}) }"
    )
    

    Your onClick argument then becomes

    onClick = JS(jsCode)
    

    This allows a modal to be displayed:

    enter image description here

    But clearly, the body of the modal needs work. I suspect you need to make more adjustments similar to those I have made elsewhere, but - as I said - I don't know reactable. Or did you intend to display a blank modal?

    Here's the full code of the MWE.

    library(shiny)
    library(reactable)
    
    n = c(2, 3, 5) 
    s = c("aa", "bb", "cc") 
    b = c(TRUE, FALSE, TRUE) 
    dframe = data.frame(n, s, b) 
    
    
    tUI <- function(idd){
      ns <- NS(idd)
      tagList(
        reactableOutput(ns("table"))
      )
    }
    
    tServer <- function(idd, d) {
      moduleServer(
        idd,
        function(input, output, session) {
          ns <- session$ns
                     
          jsCode <- paste0("function(rowInfo) { Shiny.setInputValue('", ns("idd-name"), "', {id:rowInfo.id}) }")
          
          output$table <- renderReactable(
            reactable(
              d,
              compact = T,
              rowStyle = list(cursor = "pointer"),
              defaultColDef = colDef(align = "left", maxWidth = 60),
              onClick = JS(jsCode),
            )
          )
                     
          observeEvent(
            input[["idd-name"]], {
              row_nr <- as.numeric(input[["idd-name"]])+1
              showModal( modalDialog(title = dframe$s[row_nr]))
            }
          )
        })
    }
    
    ui <- fillPage(
      tUI("tt")
    )
    server <- function(input,output,session){
      ttt <- tServer("tt", d = dframe)
    }
    shinyApp(ui,server)
    

    Also, you wrote 'I called the namespace "idd"...'. Actually, you didn't. You called the namespace tt. The variable that stores the name of the namespace is idd. I wonder if that's the cause of some of your confusion...