Как извлечь и сохранить изменения манипуляции visNetwork в Shiny?

Question

Я пытаюсь сделать приложение интерактивной сети / карты разума блестящим с visNetwork. visNetwork позволяет интерактивно создавать и манипулировать сетевым графиком, как я могу сохранить эти результаты в R data.frame?

Я посмотрел на документацию, но не смог понять, как извлечь изменения.

Ниже приведен код блестящего приложения.

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 опция возвращает список, описывающий то, что пользователь только что изменил. Мы можем использовать эту информацию для обновления наших основных фреймов данных узлов и ребер.

Этот код отображает график, который пользователь может редактировать, и две таблицы, показывающие все узлы и ребра, которые в настоящее время находятся на графике, включая изменения пользователя. ( Этот ответ предоставил полезное руководство о том, как использовать 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)