r语言 - 如何在一个闪亮的仪表板中引用多个GraphViz图形

Question

我有一个闪亮的仪表板，其中包含多个逻辑链接的选项卡，因此我使用GraphViz创建了一个DiagrammeR图来显示它们之间的关系。我希望能够在GraphViz图中的一个节点上注册单击事件时触发对新选项卡的更改。

图表将在每个选项卡的顶部，所以有多个图表需要点击。

我已经得到了它的大部分工作，如图所示:

library(shinydashboard)
library(DiagrammeR)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "DiagrammeR buttons"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Tab 1", tabName = "one", icon = icon("dice-one")),
menuItem("Tab 2", tabName = "two", icon = icon("dice-two"))
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem(tabName = "one",
fluidRow(box(grVizOutput("diagram_a", width = "100%", height = "100%"), width = 12))
),
tabItem(tabName = "two",
fluidRow(box(grVizOutput("diagram_b", width = "100%", height = "100%"), width = 12))
)
)
)
)
server <- function(input, output, session) {

output$diagram_a <- renderGrViz({grViz("digraph {
graph[rankdir = LR]
node [style = filled]
n1_1 -> n1_2
}")})

output$diagram_b <- renderGrViz({grViz("digraph {
graph[rankdir = LR]
node [style = filled]
n2_1 -> n2_2
}")})

observeEvent(eventExpr = input$clickednode, {
updateTabItems(session, "tabs", input$clickednode)
})
observe({
local({
clicked = "Shiny.onInputChange('clickednode', 'one')"
shinyjs::onclick("node1",runjs(clicked))
})
local({
clicked = "Shiny.onInputChange('clickednode', 'two')"
shinyjs::onclick("node2",runjs(clicked))
})
})
}
shinyApp(ui, server)

唯一的问题是只有仪表板中的第一个图形注册了单击事件。本例中的第二个选项卡只是一个不能与之交互的静态图。

我需要一些帮助，以确保我指的是我感兴趣的特定node1和node2，而不仅仅是出现在仪表板中的第一个node1或node2。我不知道如何在JavaScript中做到这一点。

注意:nodeX，其中X是一个数字，是shiny自动给每个graphViz图中的节点的id。这可以通过检查仪表板html找到。

Answer 1

1. 使用的每个节点的id。在HTML中，应该强烈避免使用重复的id。即使您将每个plot的文本更改为n1_1和n2_1，默认id始终是node1,node2,node3…您需要手动更改它。
2. 建议:使用setInputValue代替onInputChange。

以下是如何为GraphViz中的每个节点设置唯一id的方法。看看GraphViz的语法会有帮助的。

library(shinydashboard)
library(DiagrammeR)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "DiagrammeR buttons"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Tab 1", tabName = "one", icon = icon("dice-one")),
menuItem("Tab 2", tabName = "two", icon = icon("dice-two"))
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem(tabName = "one",
fluidRow(box(grVizOutput("diagram_a", width = "100%", height = "100%"), width = 12))
),
tabItem(tabName = "two",
fluidRow(box(grVizOutput("diagram_b", width = "100%", height = "100%"), width = 12))
)
)
)
)
server <- function(input, output, session) {

output$diagram_a <- renderGrViz({grViz('digraph {
graph[rankdir = LR]
node [style = filled]
n1_1 -> n1_2
n1_1[id="d1_n1"]
n1_2[id="d1_n2"]
}')})

output$diagram_b <- renderGrViz({grViz('digraph {
graph[rankdir = LR]
node [style = filled]
n2_1 -> n2_2
n2_1[id="d2_n1"]
n2_2[id="d2_n2"]
}')})

observeEvent(input$clickednode, {
updateTabItems(session, "tabs", input$clickednode)
})

observe({
local({
clicked = "Shiny.setInputValue('clickednode', 'one')"
shinyjs::onclick("d1_n1",runjs(clicked)) 
shinyjs::onclick("d2_n1",runjs(clicked))
})
local({
clicked = "Shiny.setInputValue('clickednode', 'two')"
shinyjs::onclick("d1_n2",runjs(clicked)) 
shinyjs::onclick("d2_n2",runjs(clicked))
})
})
}
shinyApp(ui, server)