Shiny & networkD3 响应节点点击答案

【问题标题】：Shiny & networkD3 responding to node clickShiny & networkD3 响应节点点击
【发布时间】：2017-10-07 23:34:08
【问题描述】：

我正在尝试使用networkD3 和闪亮来可视化一些数据。我希望在单击图表中的节点时发生动作。我正在使用diagonalNetwork 函数，如下面的代码所示。

forceNetwork 函数有一个选项可以让clickaction 在节点被点击时做出响应。但是，我找不到 diagonalNetwork 函数的类似选项。还有其他方法可以实现吗？

#### Load necessary packages and data ####
library(shiny)
library(networkD3)

data(MisLinks)
data(MisNodes)

hc <- hclust(dist(USArrests), "ave")
URL <- paste0(
  "https://cdn.rawgit.com/christophergandrud/networkD3/",
  "master/JSONdata//flare.json")



## Convert to list format
Flare <- jsonlite::fromJSON(URL, simplifyDataFrame = FALSE)


#### Server ####
server <- function(input, output) {

  output$simple <- renderDiagonalNetwork({
    diagonalNetwork(List = Flare, fontSize = 10, opacity = 0.9)
  })  


  output$force <- renderForceNetwork({
    forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
                 Target = "target", Value = "value", NodeID = "name",
                 Group = "group", opacity = input$opacity)


  })

  ## 
  #dendroNetwork(hc, height = 600)
 # 
#  dendroNetwork(hc, height = 500, width = 800, fontSize = 10,
#                linkColour = "#ccc", nodeColour = "#fff", nodeStroke = "steelblue",
#                textColour = "#111", textOpacity = 0.9, textRotate = NULL,
#                opacity = 0.9, margins = NULL, linkType = c("elbow", "diagonal"),
#                treeOrientation = c("horizontal", "vertical"), zoom = FALSE)



}

#### UI ####

ui <- shinyUI(fluidPage(

  titlePanel("Shiny networkD3 "),

  sidebarLayout(
    sidebarPanel(
      sliderInput("opacity", "Opacity (not for Sankey)", 0.6, min = 0.1,
                    max = 1, step = .1)
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("Simple Network", diagonalNetworkOutput("simple")),
        tabPanel("Force Network", forceNetworkOutput("force"))
      )
    )
  )
))

#### Run ####
shinyApp(ui = ui, server = server)

【问题讨论】：

标签： javascript r shiny htmlwidgets networkd3

【解决方案1】：

您可以使用htmlwidgets 的onRender 函数将onclick 事件附加到这样的节点...

library(shiny)
library(networkD3)
library(htmlwidgets)

URL <- "https://raw.githubusercontent.com/christophergandrud/networkD3/master/JSONdata/flare.json"
Flare <- jsonlite::fromJSON(URL, simplifyDataFrame = FALSE)

clickJS <- 'd3.selectAll(".node").on("click", function(d){ alert(d.data.name); })'
  
server <- function(input, output) {
  output$simple <- renderDiagonalNetwork({
    onRender(diagonalNetwork(List = Flare, fontSize = 10, opacity = 0.9), clickJS)
  })
}

ui <- fluidPage(
    diagonalNetworkOutput("simple"),
    tags$script(clickJS)
)

shinyApp(ui = ui, server = server)

【讨论】：