如何在Shiny模块产生的DiagrammeR输出中找到被点击的元素。

Question

我需要识别DiagrammeR输出中的哪个节点在Shiny应用中被点击过。 以下是 此职位当输出不是由模块产生时，我可以得到我需要的信息。 但是在一个模块中（我真正的使用案例），同样的逻辑似乎不工作。 我不知道为什么，但我注意到DiagrammeR节点似乎并不尊重模块的命名空间（也就是说，第一个节点的id是-----------------）。node1 而非 <namespace>-node1).

我做错了什么，或者这是DiagrammeR的一个错误？

这是我的示例代码。

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

我已经回答了我自己的问题，依据是 本期 在DiagrammeR的GitHub仓库中，不需要javascript或其他复杂功能。

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)