问题
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)
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)
回答1:
You almost definitely need to use forceNetwork
, because it has a clickAction
argument that lets you add JavaScript. This is a really rough example...
clickJS <- "
d3.selectAll('.xtooltip').remove();
d3.select('body').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')
.html('name: ' + d.name + '<br>' + 'group: ' + d.group)
.style('left', (d3.event.pageX) + 'px')
.style('top', (d3.event.pageY - 28) + 'px');
"
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")
node_names <- factor(sort(unique(c(as.character(src),
as.character(target)))))
nodes <- data.frame(name = node_names, group = 1, size = 8)
links <- data.frame(source = match(src, node_names) - 1,
target = match(target, node_names) - 1,
value = 1)
forceNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", clickAction = clickJS)
})
}
ui <- shinyUI(fluidPage(simpleNetworkOutput("simple")))
shinyApp(ui = ui, server = server)
来源:https://stackoverflow.com/questions/44110370/implementing-tooltip-for-networkd3-app