如何在 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)
我需要确定在 Shiny 应用程序中点击了 DiagrammeR 输出中的哪个节点。按照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)