如何在 shinydashboard 中引用多个 DiagrammeR GraphViz 图

How to refer to multiple DiagrammeR GraphViz graphs in a shinydashboard

我有一个闪亮的仪表板,其中包含逻辑上链接的多个选项卡,因此我使用 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)

唯一的问题是只有仪表板中的第一个图表注册了点击事件。此示例中的第二个选项卡只是一个无法与之交互的静态图表。

我需要一些帮助,以确保我提到了我感兴趣的特定 node1node2,而不仅仅是第一个 node1node2出现在仪表盘中。我不确定如何在 JavaScript.

中做到这一点

注意: nodeX 其中 X 是一个数字,是闪亮自动赋予每个 graphViz 图中节点的 ID .这可以通过检查仪表板找到 html.

  1. 为每个节点使用唯一 ID。在 HTML 中,应强烈避免重复 ID。即使您将每个图的文本更改为 n1_1n2_1,默认 ID 始终为 node1node2node3 ... 您需要手动更改它。
  2. 建议:使用 setInputValue 而不是 onInputChange

以下是如何在 GraphViz 中为每个节点设置唯一 ID。看看 GraphViz grammar 会有帮助。

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)