Javascript networkD3:：sankeyNetwork中的R自定义工具提示

我们创建了sankey图，通过R中的

networkD3:：sankeyNetwork（）

显示不同城市之间的流量。 我们已收到客户要求在sankey节点的工具提示/悬停上显示与城市对应的“州”名称

在下面的代码中，我们希望在节点的工具提示（悬停）上显示状态值

库（闪亮）
图书馆（网络3）
图书馆（shinydashboard）
值您可以使用类似的技术。保存
sankeyNetwork
函数的输出，然后重新添加剥离的数据，然后使用
htmlwidgets:：onRender
添加一些JavaScript来修改节点的工具提示文本

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)

库（闪亮）
图书馆（网络3）
图书馆（shinydashboard）
您能给出一个可复制的例子吗？可复制的代码已经在上面的描述中提到，变量“状态”应该显示在工具提示上。您能检查并建议实现结果的方法吗？
nodes感谢您的更正，它现在已更新，您能现在查看吗？如果我尝试使用其他sankey库，您是否可以？还是应该仅此？谢谢您提供了很好的解决方案！！。它的工作方式正是我想要的，但是我已经用“title”替换了“title foreignObject body pre”以使其工作。