是否可以使用 actionButton 清除 ShinyApp 中显示的输出

Question

我正在 mtcars 数据 上构建一个 shinyApp。我有 2 个操作按钮 (Go & Clear)。 Go 按钮 用于在 mainPanel 上显示输出，而 Clear 按钮 用于清除该输出。由于某些不可预见的原因，我的清除按钮不起作用。有人可以看看我的代码吗？将不胜感激。

library(shiny)   
library(DT)     
library(dplyr) 
library(shinythemes) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)

data_table<-mtcars

#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (

      uiOutput("cyl_selector"),
      uiOutput("disp_selector"),

      actionButton(inputId = "go", label = "Go"),
      actionButton(inputId = "reset", label = "Clear")),


    mainPanel(
           DT::dataTableOutput('mytable') )))



#server
server = function(input, output, session) {

  output$cyl_selector <- renderUI({

    selectInput(inputId = "cyl",
                label = "cyl:", multiple = TRUE,
                choices = c( unique(as.character(data_table$cyl))),
                selected = c('4')) })


  output$disp_selector <- renderUI({

    available <- data_table[c(data_table$cyl %in% input$cyl ), "disp"]  

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All') })


  thedata <- eventReactive(input$go,{

    data_table<-data_table[data_table$cyl %in% input$cyl,]


    if(input$disp != 'All'){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }

    data_table
 })


 # thedata <- eventReactive(input$reset,{
 #   data_table<-NULL
 # })


  output$mytable = DT::renderDataTable({

    DT::datatable( filter = "top",  rownames = FALSE, escape = FALSE,
                   options = list(pageLength = 50, autowidth=FALSE,
                                  dom = 'Brtip'  ),
                   {     
                     thedata()   # Call reactive thedata()
                   })
 })}  
shinyApp(ui = ui, server = server)

Answer 1

insertUI() 和 removeUI() 是您可能正在寻找的。

删除元素更容易 removeUI():

  observeEvent(input$reset, {
    removeUI("#mytable")
  })

为避免您不永久删除它，您可以使用 insertUI():

  observeEvent(input$go, {
    insertUI("#placeholder", "afterEnd", ui = DT::dataTableOutput('mytable'))
  })

为了正确放置元素，您可以在 mainPanel():

中使用占位符

mainPanel(
  tags$div(id = "placeholder")
)

然后你可以从输入按钮中删除 thedata() 的依赖，因为你现在使用 insertUI()。（你应该切换到 insertUI()，否则你不能重新插入 table 一旦它被删除没有它，...）

  thedata <- reactive({
     ...
  })

完整示例如下：

library(shiny)   
library(DT)     
library(dplyr) 
library(shinythemes) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)

data_table<-mtcars

#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (

      uiOutput("cyl_selector"),
      uiOutput("disp_selector"),

      actionButton(inputId = "go", label = "Go"),
      actionButton(inputId = "reset", label = "Clear")),


    mainPanel(
      tags$div(id = "placeholder")
    )
  )
)



#server
server = function(input, output, session) {

  output$cyl_selector <- renderUI({

    selectInput(inputId = "cyl",
                label = "cyl:", multiple = TRUE,
                choices = c( unique(as.character(data_table$cyl))),
                selected = c('4')) })


  output$disp_selector <- renderUI({

    available <- data_table[c(data_table$cyl %in% input$cyl ), "disp"]  

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All') })


  thedata <- reactive({
    input$go
    isolate({

      data_table<-data_table[data_table$cyl %in% input$cyl,]


      if(input$disp != 'All'){
        data_table<-data_table[data_table$disp %in% input$disp,]
      }

      return(data_table)
    })
  })

  observeEvent(input$reset, {
    removeUI("#mytable")
  })

  observeEvent(input$go, {
    insertUI("#placeholder", "afterEnd", ui = DT::dataTableOutput('mytable'))
  })


  output$mytable = DT::renderDataTable({

    DT::datatable( filter = "top",  rownames = FALSE, escape = FALSE,
                   options = list(pageLength = 50, autowidth=FALSE,
                                  dom = 'Brtip'  ),
                   {     
                     thedata()   # Call reactive thedata()
                   })
  })}  
shinyApp(ui = ui, server = server)
)

Answer 2

为什么不注入一些 javascript？这样，您的代码几乎保持不变。

使用以下代码在闪亮的文件夹中创建一个 js 文件（本例中为 rmDt.js）：

$("#reset").click(function() {
  $(".display.dataTable.no-footer").DataTable().destroy();
  $(".display.dataTable.no-footer").DataTable().clear().draw();    
  $(".display.no-footer").DataTable().destroy();
  $(".display.no-footer").DataTable().clear().draw();    
});

保存此文件，然后将其注入您闪亮的 R 脚本中：

library(shiny)   
library(DT)     
library(dplyr) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)

data_table<-mtcars

#ui
ui = fluidPage(
  sidebarLayout(
    sidebarPanel (
      uiOutput("cyl_selector"),
      uiOutput("disp_selector"),

      actionButton(inputId = "go", label = "Go"),
      actionButton(inputId = "reset", label = "Clear"),
      includeScript(path ="rmDt.js") # inject javascript
      ),

    mainPanel(
      DT::dataTableOutput('mytable') ))
  )



#server
server = function(input, output, session) {

  output$cyl_selector <- renderUI({

    selectInput(inputId = "cyl",
                label = "cyl:", multiple = TRUE,
                choices = c( unique(as.character(data_table$cyl))),
                selected = c('4')) })


  output$disp_selector <- renderUI({

    available <- data_table[c(data_table$cyl %in% input$cyl ), "disp"]  

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All') })


  thedata <- eventReactive(input$go,{

    data_table<-data_table[data_table$cyl %in% input$cyl,]


    if(input$disp != 'All'){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }

    data_table
  })

  output$mytable = DT::renderDataTable({

    DT::datatable( filter = "top",  rownames = FALSE, escape = FALSE,
                   options = list(pageLength = 50, autowidth=FALSE,
                                  dom = 'Brtip'  ),
                   {     
                     thedata()   # Call reactive thedata()
                   })
  })}  
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

是否可以使用 actionButton 清除 ShinyApp 中显示的输出

Is it possible to clear the displayed output in ShinyApp using actionButton

r

shiny

shinydashboard

dt

action-button