按下操作按钮后清空由 reactiveValues() 创建的数据框

Question

我有一个简单的闪亮应用程序，它可以可视化下面的网络：当您单击一个节点时，会创建一个反应性数据框并在应用程序中显示。但随后我想按下操作按钮并清空该表。当我选择另一个节点时，将再次创建表。我为此使用了reactiveValues() 和观察者，但我的应用程序正在崩溃。

library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)
library(DT)
library(shinydashboard)
#dataset
id<-c("articaine","benzocaine","etho","esli")
label<-c("articaine","benzocaine","etho","esli")
node<-data.frame(id,label)

from<-c("articaine","articaine","articaine",
        "articaine","articaine","articaine",
        "articaine","articaine","articaine")
to<-c("benzocaine","etho","esli","benzocaine","etho","esli","benzocaine","etho","esli")
title<-c("SCN1A","SCN1A","SCN1A","SCN2A","SCN2A","SCN2A","SCN3A","SCN3A","SCN3A")

edge<-data.frame(from,to,title)


#app

ui <- dashboardPage(

  # Generate Title Panel at the top of the app
  dashboardHeader(
  title="Network Visualization App"),
  dashboardSidebar(
    actionButton("update","Update data")
  ),
  dashboardBody(
  fluidRow(
    column(width = 6,
           DTOutput('tbl')
           ),
    column(width = 6,
           visNetworkOutput("network")) #note that column widths in a fluidRow should sum to 12
  )
  )
) #end of fluidPage


server <- function (input, output, session){

  output$network <- renderVisNetwork({
    visNetwork(nodes = node,edge) %>% 
      visOptions(highlightNearest=TRUE, 
                 nodesIdSelection = TRUE) %>%
      #allow for long click to select additional nodes
      visInteraction(multiselect = TRUE) %>%
      visIgraphLayout() %>% 

      #Use visEvents to turn set input$current_node_selection to list of selected nodes
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_selection', nodes.nodes);
                ;}")

  })
 rt<-reactive({
   colnames(edge)<- c("Target 1","Target 2","Shared Drug")
   edge %>% 
     filter((edge[,1] %in% input$current_node_selection)|(edge[,2] %in% input$current_node_selection))
 })
 ####WRONG APPROACH

 #rt<-reactiveValues({
 #  colnames(edge)<- c("Target 1","Target 2","Shared Drug")
 #  edge %>% 
  #   filter((edge[,1] %in% input$current_node_selection)|(edge[,2] %in% input$current_node_selection))
 #})

 #observeEvent(input$update, {
 # rt = rt[FALSE,]
 #})
 #####


  #render data table restricted to selected nodes
  output$tbl <- renderDT(
    rt()
  )

}

shinyApp(ui, server)

Answer 1

您可以结合使用 reactiveValue、observe 和 observeEvent。您将创建一个将在表的过滤器中使用的 reactiveValue，它将通过 observeEvent 进行归因。然后，当按下按钮时，您可以使用观察将此过滤器更新为 NULL。例如，请参见下文。如果你想对图表做同样的事情，你只需要应用相同的逻辑。

library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)
library(DT)
library(shinydashboard)
#dataset
id<-c("articaine","benzocaine","etho","esli")
label<-c("articaine","benzocaine","etho","esli")
node<-data.frame(id,label)

from<-c("articaine","articaine","articaine",
        "articaine","articaine","articaine",
        "articaine","articaine","articaine")
to<-c("benzocaine","etho","esli","benzocaine","etho","esli","benzocaine","etho","esli")
title<-c("SCN1A","SCN1A","SCN1A","SCN2A","SCN2A","SCN2A","SCN3A","SCN3A","SCN3A")

edge<-data.frame(from,to,title)


#app

ui <- dashboardPage(

  # Generate Title Panel at the top of the app
  dashboardHeader(
    title="Network Visualization App"),
  dashboardSidebar(
    actionButton("update","Update data")
  ),
  dashboardBody(
    fluidRow(
      column(width = 6,
             DTOutput('tbl')
      ),
      column(width = 6,
             visNetworkOutput("network")) #note that column widths in a fluidRow should sum to 12
    )
  )
) #end of fluidPage


server <- function (input, output, session){

  # initialize reactiveValues
  rv <- reactiveValues()


  output$network <- renderVisNetwork({
    visNetwork(nodes = node,edge) %>% 
      visOptions(highlightNearest=TRUE, 
                 nodesIdSelection = TRUE) %>%
      #allow for long click to select additional nodes
      visInteraction(multiselect = TRUE) %>%
      visIgraphLayout() %>% 

      #Use visEvents to turn set input$current_node_selection to list of selected nodes
      visEvents(select = "function(nodes) {
                Shiny.onInputChange('current_node_selection', nodes.nodes);
                ;}")

  })

  # Attribute the input value to the reactive variable
  observeEvent(input$current_node_selection, {
    rv$data <- input$current_node_selection
  })

  # watch the reset button and attribute NULL if pressed
  observe({
    input$update
    rv$data <- NULL
  })

  # filter based on reactive variable
  rt<-reactive({
    colnames(edge)<- c("Target 1","Target 2","Shared Drug")
    edge %>% 
      filter((edge[,1] %in% rv$data) | (edge[,2] %in% rv$data))
  })


  output$tbl <- renderDT({
     rt()
    })  

}

shinyApp(ui, server)