checkboxGroupInput 在闪亮的应用程序中删除表输出

Question

我正在创建一个闪亮的应用程序，单击操作按钮后，其在复选框组中的选择会返回一个包含过滤数据的表格，如下例所示。 我的问题是如何包含该功能，生成表格后，当我再次单击任何复选框时，表格将被删除，直到用户再次单击操作按钮。

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(

      checkboxGroupInput(inputId = "checkboxGroup1", label = "checkboxGroup1", choices = list(5.0, 4.6)),
      checkboxGroupInput(inputId = "checkboxGroup2", label = "checkboxGroup2", choices = list(3.4, 3.6)),
      checkboxGroupInput(inputId = "checkboxGroup3", label = "checkboxGroup3", choices = list(0.2, 1.5)),
      checkboxGroupInput(inputId = "checkboxGroup4", label = "checkboxGroup4", choices = list("setosa", "virginica")),
      actionButton('action',label = 'action'),

      mainPanel(
          dataTableOutput("table1")
        )
    )


# Define server logic required to draw a histogram
server <- function(input, output) {
  
  filter_data <- eventReactive(input$action, {
    
    data <- iris
    
    Sys.sleep(5) #included to delay the output

    data %>% 
      {if (is.null(input$checkboxGroup1) == FALSE) filter(., Sepal.Length %in% input$checkboxGroup1) else .} %>% 
      {if (is.null(input$checkboxGroup2) == FALSE) filter(., Sepal.Width %in% input$checkboxGroup2) else .} %>% 
      {if (is.null(input$checkboxGroup3) == FALSE) filter(., Petal.Width %in% input$checkboxGroup3) else .} %>%
      {if (is.null(input$checkboxGroup4) == FALSE) filter(., Species %in% input$checkboxGroup4) else .}

  })
  
  output$table1 <- renderDataTable(
    filter_data()
  )
  
}

# Run the application 
shinyApp(ui = ui, server = server)

编辑：添加“Sys.sleep(5)”以延迟输出。如果在更新之前按下操作按钮，仅隐藏表格并不能解决这种情况。

Answer 1

这里有一个使用

shinyjs

的选项。首先创建一个依赖于所有复选框输入的反应式表达式。每当选中复选框时，我们都可以使用

shinyjs::hide

隐藏 DT。然后，单击操作按钮时使用

shinyjs::show

显示表格。

带有更新的基本 UI 的演示

library(shiny)
library(DT)
library(dplyr)
library(shinyjs)

ui <- fluidPage(
    useShinyjs(), # include shinyjs here
    checkboxGroupInput(inputId = "checkboxGroup1", label = "checkboxGroup1", choices = list(5.0, 4.6)),
    checkboxGroupInput(inputId = "checkboxGroup2", label = "checkboxGroup2", choices = list(3.4, 3.6)),
    checkboxGroupInput(inputId = "checkboxGroup3", label = "checkboxGroup3", choices = list(0.2, 1.5)),
    checkboxGroupInput(inputId = "checkboxGroup4", label = "checkboxGroup4", choices = list("setosa", "virginica")),
    actionButton('action',label = 'action'),

    mainPanel(
        dataTableOutput("table1")
      )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  filter_data <- eventReactive(input$action, {
    data <- iris
    data %>% 
      {if (is.null(input$checkboxGroup1) == FALSE) filter(., Sepal.Length %in% input$checkboxGroup1) else .} %>% 
      {if (is.null(input$checkboxGroup2) == FALSE) filter(., Sepal.Width %in% input$checkboxGroup2) else .} %>% 
      {if (is.null(input$checkboxGroup3) == FALSE) filter(., Petal.Width %in% input$checkboxGroup3) else .} %>%
      {if (is.null(input$checkboxGroup4) == FALSE) filter(., Species %in% input$checkboxGroup4) else .}
  })
  
  obs_checkboxes = reactive({
    list(input$checkboxGroup1,input$checkboxGroup2,input$checkboxGroup3,input$checkboxGroup4)
  })

  observeEvent(obs_checkboxes(), {
    hide("table1")
  })
  
  observeEvent(input$action, {
    show("table1")
  })
  
  output$table1 <- renderDataTable(
    filter_data()
  )
}

# Run the application 
shinyApp(ui = ui, server = server)