How to find the clicked element in DiagrammeR output produced by a Shiny module

Question

I need to identify which node in a DiagrammeR output has been clicked in a Shiny app. Following this post, I can get the information I need when the output is not produced by a module. But in a module (my real use case), the same logic seems not to work. I can't see why, but I did notice that the DiagrammeR nodes appear not to respect the module's namespace (that is, the first node's id is node1 rather than <namespace>-node1).

What am I doing wrong, or is this a bug in DiagrammeR?

Here's my sample code.

library(shiny)
library(DiagrammeR)
library(shinyjs)

texts <- c("Clicked on A", "Clicked on B")

moduleUI <- function(id) {
  ns <- NS(id)
  tagList(uiOutput(ns("tooltip")), grVizOutput(ns("tree")))
}

moduleController <- function(input, output, session) {
  ns <- session$ns
  jsCode <- paste0("Shiny.onInputChange('", ns("clickedElemNr"), "',", 1:2, ")")

  observeEvent(input$clickedElemNr, {
    print(ns("observeEvent[clickedElemNr]"))
    output$tooltip <- renderUI({
      textInput(inputId=ns("x"), label="x", value=texts[input$clickedElemNr])
    })
  })

  observe({
    output$tooltip <- renderUI({textInput(inputId=ns("x"), label="x", value="Click an element")})
    for (i in 1:length(jsCode)) {
      local({
        jsToAdd <- jsCode[i]
        shinyjs::onclick(ns(paste0("node", i)), runjs(jsToAdd))
      })
    }
  })

  output$tree <- renderGrViz({
    grViz("digraph test {A; B; A -> B;}")
  })
}

ui <- fluidPage(
   useShinyjs(),
   column(width=4, wellPanel("No module", uiOutput("tooltip"), grVizOutput("tree"))),
   column(width=4, wellPanel("Module 1", moduleUI("mod1")))
)

server <- function(input, output) {
  jsCode <- paste0("Shiny.onInputChange('clickedElemNr',", 1:2, ")")

  callModule(moduleController, "mod1")

  observeEvent(input$clickedElemNr, {
    print("observeEvent[clickedElemNr]")
    output$tooltip <- renderUI({
      textInput(inputId="x", label="x", value=texts[input$clickedElemNr])
    })
  })

  observe({
    output$tooltip <- renderUI({textInput(inputId="x", label="x", value="Click an element")})
    for (i in 1:length(jsCode)) {
      local({
        jsToAdd <- jsCode[i]
        shinyjs::onclick(paste0("node", i), runjs(jsToAdd))
      })
    }
  })

  output$tree <- renderGrViz({
    grViz("digraph test {A; B; A -> B;}")
  })
}

shinyApp(ui = ui, server = server)

Answer 1

I've answered my own question, based on this issue in the DiagrammeR GitHub repository, with no need for javascript or other complications.

library(shiny)
library(DiagrammeR)

moduleUI <- function(id) {
  ns <- NS(id)
  tagList(
    verbatimTextOutput(ns("print")), 
    grVizOutput(ns("tree"))
  )
}

moduleController <- function(input, output, session) {
  ns <- session$ns

  txt <- reactive({
    parentSession <- .subset2(session, "parent")
    nodeVal <- input$tree_click$nodeValues[[1]]
    if (is.null(nodeVal)) return(NULL)
    return(paste(nodeVal, "is clicked"))
  })

  output$print <- renderText({
    txt()
  })

  output$tree <- renderGrViz({
    grViz("digraph test {A; B; A -> B;}")
  })
  return(txt)
}

ui <- fluidPage(
   column(width=4, wellPanel("No module", verbatimTextOutput("print"), grVizOutput("tree"))),
   column(width=4, wellPanel("Module 1", moduleUI("mod1"))),
   column(width=4, wellPanel("Module 2", moduleUI("mod2")))
)

server <- function(input, output) {
  mod1Val <- callModule(moduleController, "mod1")
  observeEvent(mod1Val(), {
    print(paste0("server[mod1]: ", mod1Val()))
  })

  mod2Val <- callModule(moduleController, "mod2")
  observeEvent(mod2Val(), {
    print(paste0("server[mod2]: ", mod2Val()))
  })

  txt <- reactive({
    req(input$tree_click)
    nodeval <- input$tree_click$nodeValues[[1]]
    return(paste(nodeval, " is clicked"))
  })

  output$print <- renderPrint({
    txt()
  })

  output$tree <- renderGrViz({
    grViz("digraph test {A; B; A -> B;}")
  })
}

shinyApp(ui = ui, server = server)