0

我有一个包含几个节点的网络图，每个节点都有一些数据，包括 ID 和它的名称。我正在构建这样的 visNetwork 对象：

getDiagramPlot <- function(nodes, edges){
  v <- visNetwork(
    nodes, 
    edges
  ) %>%
    visPhysics(stabilization = TRUE, enabled = TRUE) %>%
    visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
    visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
    visLayout(improvedLayout = TRUE) %>%
    visEdges(arrows = edges$arrows) %>%
    visInteraction(multiselect = F)
  return(v)
}

我所追求的是能够visEvents在我的代码中输入和调用函数，理想情况下将 ID 作为参数传递。就像是：

testFunction <- function(node_id){
  print(paste("The selected node ID is:", node_id))
}

我在网上看到的例子大多是alert()在他们的例子中使用 javascript，但我希望打破 javascript 并在我的代码中调用 R 函数。

对此的任何帮助将不胜感激！先感谢您。

4

1 回答 1

1

您可以Shiny.onInputChange在 javascript 中使用将任何内容设置为闪亮的输入变量。这可以解决问题。

编辑：doubleClick在 visEvents 中使用以在双击时触发代码。见https://rdrr.io/cran/visNetwork/man/visEvents.html

library(shiny)
library(visNetwork)
ui <- fluidPage(
  visNetworkOutput('network')
)

server <- function(input, output, session) {
  getDiagramPlot <- function(nodes, edges){
    v <- visNetwork(
      nodes, 
      edges
    ) %>%
      visPhysics(stabilization = TRUE, enabled = TRUE) %>%
      visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
      visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
      visLayout(improvedLayout = TRUE) %>%
      visEdges(arrows = edges$arrows) %>%
      visInteraction(multiselect = F) %>%
      visEvents(doubleClick = "function(nodes) {
            Shiny.onInputChange('current_node_id', nodes.nodes);
            ;}")
    return(v)
  }

  testFunction <- function(node_id){
    print(paste("The selected node ID is:", node_id))
  }

  nodes <- data.frame(id = 1:3, label = 1:3)
  edges <- data.frame(from = c(1,2), to = c(1,3))

  output$network <- renderVisNetwork(
    getDiagramPlot(nodes, edges)
  )

  observeEvent(input$current_node_id,{
    testFunction(input$current_node_id)
    })
}

shinyApp(ui, server)
于 2020-05-12T02:52:42.893 回答