Shiny＆networkD3響應節點點擊

我正在嘗試使用networkD3和閃亮來顯示一些數據。點擊圖表中的某個節點時，我希望有一個動作發生。我正在使用如下面代碼所示的對角線網絡。Shiny＆networkD3響應節點點擊

forceNetwork有一個選項，用於在單擊節點時進行「點擊操作」以進行響應。但是，我找不到對角線網絡的類似選項，是否有另一種方法來實現這一點？

感謝您的幫助！

#### 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)

來源

2017-05-09 Daniel Cole

你可以使用htmlwidgets的onRender功能的onclick事件附加到這樣的節點...

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)

來源

2017-05-25 12:30:16

Shiny＆networkD3響應節點點擊

回答

相關問題