2

我正在 Shiny 应用程序中构建网络分析。

我想使用visNetworkProxy函数基于节点 ids交互（聚焦/选择）节点。

但是，UI 中 selectInput 中的“nodes$id”必须预先定义。在这种情况下，我必须在服务器之外而不是在服务器内部定义节点和边。

由于我项目的性质，我必须保留在服务器中定义的节点和边，以使它们与数据库一起更新。

下面是我的代码：

  server <- function(input, output) {
  output$network_proxy_nodes <- renderVisNetwork({
    # minimal example
    nodes <- data.frame(id = 1:3)
    edges <- data.frame(from = c(1,2), to = c(1,3))

    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observe({
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green")),
      selectInput("Focus", "Focus on node :",
                  nodes$id)
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px")
    )
  )
)

shinyApp(ui = ui, server = server)

我想知道是否有一种方法可以与带有 nodes$id 的节点进行交互，同时将节点和边缘保留在服务器内。

提前致谢！

4

1 回答 1

1

这是可行的。您需要selectInput基于节点动态渲染。

library(shiny)

 server <- function(input, output) {

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

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$Focus, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node")
    )
  )
)

shinyApp(ui = ui, server = server)

编辑

在您的评论之后，添加一个按钮。

library(shiny)

 server <- function(input, output) {

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

  output$network_proxy_nodes <- renderVisNetwork({
    visNetwork(nodes, edges) %>% visNodes(color = "blue")
  })


  observeEvent(input$focus_now, {
    visNetworkProxy("network_proxy_nodes") %>%
      visFocus(id = input$Focus, scale = 4)
  })

  observeEvent(input$color, {
    visNetworkProxy("network_proxy_nodes") %>%
      visNodes(color = input$color)
  })

  output$choose_node <- renderUI({
    selectInput("Focus", "Focus on node :",
                nodes$id)
  })

}

ui <- fluidPage(
  fluidRow(
    column(
      width = 4,
      selectInput("color", "Color :",
                  c("blue", "red", "green"))
    ),
    column(
      width = 8,
      visNetworkOutput("network_proxy_nodes", height = "400px"),
      uiOutput("choose_node"),
      actionButton("focus_now", "FOCUS")
    )
  )
)

shinyApp(ui = ui, server = server)
于 2019-02-26T16:28:30.873 回答