如何在 Shiny 模块生成的 DiagrammeR 输出中找到单击的元素

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

我需要确定在 Shiny 应用程序中点击了 DiagrammeR 输出中的哪个节点。按照,当输出不是由模块产生时,我可以获得我需要的信息。但是在一个模块(我的真实用例)中,同样的逻辑似乎不起作用。我不明白为什么,但我确实注意到 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)

我已经根据 DiagrammeR GitHub 存储库中的 this issue 回答了我自己的问题,不需要 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)