How to use shinyjs to link graphviz node data to the Shiny UI htmlOutput?

Question

I'd like to be able to select a node (with tooltip) in my graphviz diagram, and have the text information associated with that node be output in the shiny UI (e.g. htmlOutput/renderUI).

This question follows on from another question (Is it possible to select a graphviz node in a shiny app (renderGrViz) and then link to other information?). Although the previous question was partly successful (e.g. I'm now able to select a node and relevant information is then produced at the bottom of the graphviz figure), it doesn't serve purposes as the output doesn't appear a part of the shiny app. As part of that question, the function Shiny.OnInputChanged(...) (or Shiny.setInputValue) was mentioned as a more convenient way to produce a similar outcome (to appending html elements via javascript) and I'm wondering if this will lead to an outcome that is more compatible with the shiny framework, and therefore could serve as an input to a shiny widget output? Unfortunately, I haven't been able to find any websites that describe a similar problem (e.g. that have to first pull data from graphviz nodes, and then connect this input to a shiny output). As such, i've pulled together an example of the successful javascript based code that I hope to recreate with shinyjs, with the addition of an htmlOutput ('info') which is where the 'texts' data will appear the appropriate node is selected.

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)

Answer 1

You could use shinyjs with onclick, Oninputchanged and renderUI for that.

Add an onclick event:

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

Producing a shiny input inside that clickevent with javascript:

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

(see details here: https://shiny.rstudio.com/articles/js-send-message.html),..

and render an ui element:

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

Reproducible example:

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)