r - 如何在 Shiny 中提取和保存 visNetwork 操作更改？

Question

我正在尝试使用 visNetwork 制作一个 Shiny 的交互式网络/思维导图应用程序。 visNetwork 允许交互式创建和操作网络图，如何将这些结果保存在 R data.frame 中？

我查看了文档，但无法理解如何提取更改。

下面是 Shiny 的应用程序的代码。

ui <- navbarPage(

   # Application title
   "Old Faithful Geyser Data",
   tabPanel("Plot"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
      mainPanel(
        visNetworkOutput("network")
      )
   )
)

server <- function(input, output) {

   output$network <- renderVisNetwork({

     nodes <- data.frame(id = 1,
                         label = 1)
     edges <- data.frame(from = as.numeric(), 
                         to = as.numeric())

     visNetwork(nodes, edges) %>% 
       visEdges(arrows = "to") %>% 
       visHierarchicalLayout(direction = "RL", levelSeparation = 500) %>% 
       visOptions(manipulation = TRUE) 

      observe({
        visNetworkProxy("network_proxy_nodes") %>%
         visUpdateNodes(nodes = input$mynetwork__graphChange)
           })

   })
}

期望的结果是将更改添加到节点和边数据框中；例子。

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

我如何实现这一目标？

Answer 1

input$[my network name]_graphChange manipulation 创建的元素option 返回一个列表，描述用户刚刚更改的内容。我们可以使用该信息来更新节点和边的主要数据帧。

此代码显示一个用户可以编辑的图形，以及两个显示图形中当前所有节点和边的表，包括用户的更改。 ( This answer 提供了有关如何使用 reactiveValues 存储动态更新的数据框的有用指导。)

require(shiny)
require(visNetwork)
library(dplyr)

# Initialize the graph with these nodes/edges.  We have to assign edges an ID
# in case the user edits them later.
init.nodes.df = data.frame(id = c("foo", "bar"),
                           label = c("Foo", "Bar"),
                           stringsAsFactors = F)
init.edges.df = data.frame(id = "foobar",
                           from = "foo", 
                           to = "bar",
                           stringsAsFactors = F)

ui <- fluidPage(
  fluidRow(
    # Display two tables: one with the nodes, one with the edges.
    column(
      width = 6,
      tags$h1("Nodes in the graph:"),
      tableOutput("all_nodes"),
      tags$h1("Edges in the graph:"),
      tableOutput("all_edges")
    ),
    # The graph.
    column(
      width = 6,
      visNetworkOutput("editable_network", height = "400px")
    )
  )
)

server <- function(input, output) {

  # `graph_data` is a list of two data frames: one of nodes, one of edges.
  graph_data = reactiveValues(
    nodes = init.nodes.df,
    edges = init.edges.df
  )

  # Render the graph.
  output$editable_network <- renderVisNetwork({
    visNetwork(graph_data$nodes, graph_data$edges) %>%
      visOptions(manipulation = T)
  })

  # If the user edits the graph, this shows up in
  # `input$[name_of_the_graph_output]_graphChange`.  This is a list whose
  # members depend on whether the user added a node or an edge.  The "cmd"
  # element tells us what the user did.
  observeEvent(input$editable_network_graphChange, {
    # If the user added a node, add it to the data frame of nodes.
    if(input$editable_network_graphChange$cmd == "addNode") {
      temp = bind_rows(
        graph_data$nodes,
        data.frame(id = input$editable_network_graphChange$id,
                   label = input$editable_network_graphChange$label,
                   stringsAsFactors = F)
      )
      graph_data$nodes = temp
    }
    # If the user added an edge, add it to the data frame of edges.
    else if(input$editable_network_graphChange$cmd == "addEdge") {
      temp = bind_rows(
        graph_data$edges,
        data.frame(id = input$editable_network_graphChange$id,
                   from = input$editable_network_graphChange$from,
                   to = input$editable_network_graphChange$to,
                   stringsAsFactors = F)
      )
      graph_data$edges = temp
    }
    # If the user edited a node, update that record.
    else if(input$editable_network_graphChange$cmd == "editNode") {
      temp = graph_data$nodes
      temp$label[temp$id == input$editable_network_graphChange$id] = input$editable_network_graphChange$label
      graph_data$nodes = temp
    }
    # If the user edited an edge, update that record.
    else if(input$editable_network_graphChange$cmd == "editEdge") {
      temp = graph_data$edges
      temp$from[temp$id == input$editable_network_graphChange$id] = input$editable_network_graphChange$from
      temp$to[temp$id == input$editable_network_graphChange$id] = input$editable_network_graphChange$to
      graph_data$edges = temp
    }
    # If the user deleted something, remove those records.
    else if(input$editable_network_graphChange$cmd == "deleteElements") {
      for(node.id in input$editable_network_graphChange$nodes) {
        temp = graph_data$nodes
        temp = temp[temp$id != node.id,]
        graph_data$nodes = temp
      }
      for(edge.id in input$editable_network_graphChange$edges) {
        temp = graph_data$edges
        temp = temp[temp$id != edge.id,]
        graph_data$edges = temp
      }
    }
  })

  # Render the table showing all the nodes in the graph.
  output$all_nodes = renderTable({
    graph_data$nodes
  })

  # Render the table showing all the edges in the graph.
  output$all_edges = renderTable({
    graph_data$edges
  })

}

shinyApp(ui = ui, server = server)