如何使用 shinyjs 将 graphviz 节点数据链接到 Shiny UI htmlOutput？答案

【问题标题】：How to use shinyjs to link graphviz node data to the Shiny UI htmlOutput?如何使用 shinyjs 将 graphviz 节点数据链接到 Shiny UI htmlOutput？
【发布时间】：2019-09-05 04:23:20
【问题描述】：

我希望能够在我的 graphviz 图中选择一个节点（带有工具提示），并在闪亮的 UI 中输出与该节点关联的文本信息（例如 htmlOutput/renderUI）。

这个问题来自另一个问题 (Is it possible to select a graphviz node in a shiny app (renderGrViz) and then link to other information?)。尽管前一个问题部分成功（例如，我现在可以选择一个节点，然后在 graphviz 图的底部生成相关信息），但它没有起到作用，因为输出没有出现在闪亮的应用程序。作为该问题的一部分，提到了函数Shiny.OnInputChanged(...)（或Shiny.setInputValue）作为产生类似结果的更方便的方法（通过javascript附加html元素），我想知道这是否会导致结果与闪亮的框架更兼容，因此可以作为闪亮小部件输出的输入？不幸的是，我找不到任何描述类似问题的网站（例如，必须首先从 graphviz 节点提取数据，然后将此输入连接到闪亮的输出）。因此，我汇总了一个成功的基于 javascript 的代码示例，我希望使用 shinyjs 重新创建它，并添加了一个 htmlOutput ('info')，它是 'texts' 数据将出现的位置，选择了适当的节点.

library(DiagrammeR)
library(shiny)
library(shinyjs)

texts <- c("Great div for A", "Even better div for B")

jsCode <- paste0("
    elem = document.getElementById('graphV');
        var node = document.createElement('div');
        var textnode = document.createTextNode('", texts,"');
        node.appendChild(textnode);
        elem.appendChild(node);
")

ui = shinyUI(
  fluidPage(
    useShinyjs(),
    sidebarLayout(
      sidebarPanel(htmlOutput('info')),
      mainPanel(grVizOutput('graphV'))
  ))
) 

server = function(input, output, session) {

  observe({
    for(nodeNr in 1:length(jsCode)){
      local({
        jsToAdd <- jsCode[nodeNr]
        shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd)) 
      })

    }
  })

  output$graphV <- renderGrViz({ 
    grViz( "digraph test{
           A[tooltip='A word']; 
           B[tooltip='Another word'];
           A -> B;}" )
  })}

shinyApp(ui = ui, server = server)

【问题讨论】：

sry 忙碌的一周希望接下来的几天能找到一些时间，...

标签： r shiny graphviz shinyjs diagrammer

【解决方案1】：

您可以将shinyjs 与onclick、Oninputchanged 和renderUI 一起使用。

添加点击事件：

 shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd))

使用 javascript 在该 clickevent 中生成闪亮的输入：

jsCode <- paste0("Shiny.onInputChange('clickedElemNr',", 1:2,")")

（在此处查看详细信息：https://shiny.rstudio.com/articles/js-send-message.html），..

并渲染一个 ui 元素：

observeEvent(eventExpr = input$clickedElemNr,{
        output$tooltip <- renderUI({
          textInput(inputId = "x", label = "x", value = texts[input$clickedElemNr])
        })
      })

可重现的例子：

library(DiagrammeR)
library(shiny)
library(shinyjs)

texts <- c("Great div for A", "Even better div for B")

jsCode <- paste0("Shiny.onInputChange('clickedElemNr',", 1:2,")")

ui = shinyUI(
  fluidPage(
    useShinyjs(),
    sidebarLayout(
      sidebarPanel(htmlOutput('info'), uiOutput("tooltip")),
      mainPanel(grVizOutput('graphV'))
    ))
) 

server = function(input, output, session) {

  observeEvent(eventExpr = input$clickedElemNr,{
    output$tooltip <- renderUI({
      textInput(inputId = "x", label = "x", value = texts[input$clickedElemNr])
    })
  })

  observe({
    for(nodeNr in 1:length(jsCode)){
      local({
        jsToAdd <- jsCode[nodeNr]
        shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd)) 
      })

    }
  })

  output$graphV <- renderGrViz({ 
    grViz( "digraph test{
           A[tooltip='A word']; 
           B[tooltip='Another word'];
           A -> B;}" )
})}

shinyApp(ui = ui, server = server)

【讨论】：