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

您可以结合使用reactValue，observe和observeEvent。您将创建一个reactiveValue，该值将在表的过滤器中使用，并将通过observeEvent进行归因。然后，当按钮被按下时，您可以使用observe将过滤器更新为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)

按下动作按钮后清空由reactValues（）创建的数据框

1 个答案: