R-Angepasste Tooltip in sankeyNetwork-NETWORKD3

Question

Wir haben erstellt Sankey-Diagramm zu zeigen, den Fluss zwischen verschiedenen Städten über sankeynetwork-networkd3 in R. Wir haben Client Anforderung zu zeigen, "Zustand" Name entsprechend der Stadt auf Tooltip/Hover von Sankey Knoten.

Im folgenden Code wollen wir Staats Wert auf Tooltip (Schweben) des Knotens

library(shiny) 
    library(networkD3) 
    library(shinydashboard) 
    value <- c(12,21,41,12,81) 
    source <- c(4,1,5,2,1) 
    target <- c(0,0,1,3,3) 

    edges2 <- data.frame(cbind(value,source,target)) 

    names(edges2) <- c("value","source","target") 
    indx <- c(0,1,2,3,4,5) 
    ID <- c('CITY1','CITY2','CITY3','CITY4','CITY5','CITY6') 
    State <- c('IL','CA','FL','NW','GL','TX') 
    nodes <-data.frame(cbind(ID,indx,State)) 

    ui <- dashboardPage(
     dashboardHeader(
    ), 
     dashboardSidebar(disable = TRUE), 
     dashboardBody(
     fluidPage(
      sankeyNetworkOutput("simple") 
     ) 
    ) 
    ) 

    server <- function(input, output,session) { 


     output$simple <- renderSankeyNetwork({ 
     sankeyNetwork(Links = edges2, Nodes = nodes, 
         Source = "source", Target = "target", 
         Value = "value", NodeID = "ID" 
         ,units = " ") 
     }) 
    } 
    shinyApp(ui = ui, server = server) 

Als networkD3 Paket bietet keine Funktion von maßgeschneiderten Tooltip zeigen, wie Sie vorschlagen, es über Javascript erreicht werden kann/oder auf andere Weise in NetworkD3-sankeynetwork.

Answer 1

Sie können eine ähnliche Technik wie Stack Overflow answer verwenden. Speichern Sie die Ausgabe der sankeyNetwork Funktion, dann in den Daten wieder hinzufügen, die aus gestrippt wird, dann htmlwidgets::onRender verwenden einige JavaScript hinzufügen, um den Tooltip-Text der Knoten zu ändern ...

library(shiny) 
library(networkD3) 
library(shinydashboard) 
value <- c(12,21,41,12,81) 
source <- c(4,1,5,2,1) 
target <- c(0,0,1,3,3) 

edges2 <- data.frame(cbind(value,source,target)) 

names(edges2) <- c("value","source","target") 
indx <- c(0,1,2,3,4,5) 
ID <- c('CITY1','CITY2','CITY3','CITY4','CITY5','CITY6') 
State <- c('IL','CA','FL','NW','GL','TX') 
nodes <-data.frame(cbind(ID,indx,State)) 

ui <- dashboardPage(
    dashboardHeader(
    ), 
    dashboardSidebar(disable = TRUE), 
    dashboardBody(
     fluidPage(
      sankeyNetworkOutput("simple") 
     ) 
    ) 
) 

server <- function(input, output,session) { 


    output$simple <- renderSankeyNetwork({ 
     sn <- sankeyNetwork(Links = edges2, Nodes = nodes, 
         Source = "source", Target = "target", 
         Value = "value", NodeID = "ID" 
         ,units = " ") 

     # add the states back into the nodes data because sankeyNetwork strips it out 
     sn$x$nodes$State <- nodes$State 

     # add onRender JavaScript to set the title to the value of 'State' for each node 
     sn <- htmlwidgets::onRender(
      sn, 
      ' 
      function(el, x) { 
       d3.selectAll(".node").select("title foreignObject body pre") 
       .text(function(d) { return d.State; }); 
      } 
      ' 
     ) 

     # return the result 
     sn 
    }) 
} 
shinyApp(ui = ui, server = server)