如何使用shinyjs到graphviz的节点数据链接到闪亮的UI htmlOutput？(How

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

这个问题从另一个问题（如下关于是否有可能选择一个闪亮的应用程序（renderGrViz）一个graphviz的节点，然后链接到其他信息？）。虽然前面的问题，部分是成功的（例如，我现在能够选择的节点和相关的信息，然后在graphviz的图的底部产生的），当输出不会出现的一部分它不会成为目的闪亮的应用程序。作为这个问题的一部分，功能Shiny.OnInputChanged(...)或Shiny.setInputValue ）提到以产生类似的结果（以附加通过JavaScript的HTML元素）更方便的方式，我想知道如果这能导致的结果是与有光泽的框架更兼容，因此可以作为输入到一个闪亮的小组件输出？不幸的是，我一直没能找到描述类似问题的任何网站（如即必须首先从graphviz的节点提取数据，然后将此输入连接到一个闪亮的输出）。因此，我已经拉到一起成功的基于JavaScript的代码，我希望能与shinyjs重建的例子，加上一个htmlOutput（“信息”），这是在“文本”的数据将出现在合适的节点被选择。

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)

你可以使用shinyjs用onclick ， Oninputchanged和renderUI了点。

添加一个onclick事件：

 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)