R- 사용자 정의 툴팁 sankeyNetwork-NETWORKD3

Question

sankeynetwork-networkd3을 통해 R에있는 다른 도시 간 흐름을 표시하는 Sankey 다이어그램을 만들었습니다. sankey의 툴팁/호버에 도시에 해당하는 "주"이름을 표시하라는 클라이언트 요구 사항을 받았습니다 마디. 코드를 다음에서

우리가 networkD3 패키지 사용자 정의 툴팁의 기능을 제공하지 않기 때문에,이 자바 스크립트를 통해 달성 할 수있는 방법을 제안 해주십시오

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) 

노드의 툴팁 (마우스 오버)에 상태 값을 표시하려면/또는 네트워크 D3-sankeynetwork에서 다른 방법으로.

Answer 1

Stack Overflow answer과 유사한 기술을 사용할 수 있습니다.

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)