Shiny & networkD3 노드 클릭에 응답합니다.

Question

일부 데이터를 시각화하기 위해 networkD3 및 shiny를 사용하려고합니다. 그래프의 노드를 클릭했을 때 액션이 발생하도록하고 싶습니다. 아래 코드와 같이 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)

Answer 1

당신은이 같은 노드에 onclick 이벤트를 첨부 할 htmlwidgets의 onRender 기능을 사용할 수 있습니다 ...

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

URL <- paste0(
    "https://cdn.rawgit.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)