在 Networkd3 Sankey Chart (R/Shiny) 中返回节点名称

Question

我的 R/Shiny 应用程序中有一个 networkd3 Sankey 图，它从 MySQL 连接中提取数据。我试图找到一种“深入”图表的方法 - 单击一个节点，这将返回该节点的名称。然后我将使用它来将另一个查询传递给数据库，该数据库将在应用程序中填充一个表。

这是我所拥有的 -

san <- sankeyNetwork(Links = sanData, Nodes = nodes, Source = "source",
    Target = "target", Value = "value")

这绘制了运行良好的图表。

这是我迄今为止尝试过的 -
使用 R package htmlwidgets，并在我的桑基图上使用onRender运行以下 JS 脚本。

JS 脚本的占位符：

clickFun <- 'd3.selectAll(".link").on("click",function(d) {alert(d.value);})'

在我的桑基输出中：
onRender(san, clickFun)

这会将链接的值作为警报返回。我尝试按照其他一些示例的建议使用".node"和d.data.name，但我永远无法使其正常工作并且没有弹出警报。

以下是我的问题：
1. 如何在单击鼠标时从桑基图中检索节点的名称？
2. 假设我已经实现了上述目标，如何在闪亮的应用程序中使用我的 JS 脚本返回的值？我会将alert()位更改为return()，但我不知道如何在我的服务器应用程序中使用它。

Answer 1

您的单击事件适用于链接而不适用于节点的原因是因为节点还具有附加到它们的拖动行为。解决这个问题的最简单方法是取消拖动行为，然后添加点击行为，就像这样......

library(networkD3)
library(htmlwidgets)

URL <- paste0('https://cdn.rawgit.com/christophergandrud/networkD3/',
              'master/JSONdata/energy.json')
energy <- jsonlite::fromJSON(URL)

san <- 
  sankeyNetwork(Links = energy$links, Nodes = energy$nodes, Source = 'source',
              Target = 'target', Value = 'value', NodeID = 'name',
              units = 'TWh', fontSize = 12, nodeWidth = 30)

clickFun <- 
  'function() { 
      d3.selectAll(".node").on("mousedown.drag", null);
      d3.selectAll(".node").on("click",function(d) { alert(d.name); })
   }'

onRender(san, clickFun)

这是一个工作示例，其中 onclick 事件返回被单击节点的名称，然后将其传递给处理 SQL 命令的 R 函数并将结果返回给数据表命令，该命令显示从该节点跟随的链接...

library(shiny)
library(networkD3)
library(DT)
library(sqldf)
library(htmlwidgets)

URL <- paste0('https://cdn.rawgit.com/christophergandrud/networkD3/',
              'master/JSONdata/energy.json')
energy <- jsonlite::fromJSON(URL)

energy$links$name <- energy$nodes$name[energy$links$source + 1]
df <- energy$links

funct <-
  function (n) {
    isp <- sprintf("Select * From df Where df.name='%s';", n)
    isd <- sqldf::sqldf(isp)
    return(isd)
  }

ui <- shinyUI(fluidPage(
  fluidRow(
    column(4, sankeyNetworkOutput("sankey")),
    column(4, DT::dataTableOutput("table"))
  )
))

server <- shinyServer(function(input, output, session) { 
  session$onSessionEnded(stopApp)
  output$sankey <- renderSankeyNetwork({
    san <- 
      sankeyNetwork(Links = energy$links, Nodes = energy$nodes, Source = 'source',
                    Target = 'target', Value = 'value', NodeID = 'name',
                    units = 'TWh', fontSize = 12, nodeWidth = 30)

    clickFun <- 
      'function() { 
          d3.selectAll(".node").on("mousedown.drag", null);
          d3.selectAll(".node").on("click",function(d) { Shiny.onInputChange("id", d.name); });
        }'

    onRender(san, clickFun)
  })

  output$table <- DT::renderDataTable(DT::datatable(funct(input$id)))
})

shinyApp(ui = ui, server = server)