Implementing tooltip for networkD3 app

user_1156245 0
Viewed 851

I want to implement a tooltip in Shiny-hosted networkD3 plot similar to the ggvis function, e.g:

require(ggvis); require(shiny)
all_values = function(x){ "<a href='#'>Option 1</a><br/><a href='#'>Option 2</a>"}

server = function(input, output, session) {
  observe({
    ggvis(mtcars, ~disp, ~mpg) %>% layer_points() %>%
      add_tooltip(all_values, 'click') %>% 
      bind_shiny('ggvis_plot', 'ggvis_ui')
  })
}

ui = fluidPage( uiOutput("ggvis_ui"), ggvisOutput("ggvis_plot"))
shinyApp(ui, server)

enter image description here

Is there an elegant Shiny or D3/javascript way to achieve this for a simple networkD3 plot - such as below?

library(shiny); library(networkD3)

server <- function(input, output) {
  output$simple <- renderSimpleNetwork({
    src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
    target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
    networkData <- data.frame(src, target)
    simpleNetwork(networkData)
  })
}

ui <- shinyUI(fluidPage(simpleNetworkOutput("simple")))
shinyApp(ui = ui, server = server)
networkd3 shiny r
2 Answers

This could also be achieved with networkD3::simpleNetwork using htmlwidgets::onRender

library(shiny)
library(networkD3)
library(htmlwidgets)

clickJS <- "
function(el) {
  d3.select(el)
    .append('div')
    .attr('class', 'xtooltip')
    .style('position', 'absolute')
    .style('border', '1px solid #999')
    .style('border-radius', '3px')
    .style('padding', '5px')
    .style('opacity', '0.85')
    .style('background-color', '#fff')
    .style('box-shadow', '2px 2px 6px #888888')
  ;

  d3.select(el)
    .selectAll('.node')
    .on('click', function(d) { 
      d3.select(el)
        .select('.xtooltip')
        .html('name: ' + d.name + '<br>' + 'group: ' + d.group)
        .style('left', (d3.event.pageX) + 'px')
        .style('top', (d3.event.pageY - 28) + 'px')
      ;
    })
}
"

server <- function(input, output) {
  output$simple <- renderSimpleNetwork({
    src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
    target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
    networkData <- data.frame(src, target)
    sn <- simpleNetwork(networkData)
    onRender(sn, clickJS)
  })
}

ui <- shinyUI(fluidPage(simpleNetworkOutput("simple")))
shinyApp(ui = ui, server = server)
user_43897630
Related