1

I'm building a shinyApp on mtcars data. I got 2 actionButtons (Go & Clear). The Go button is for displaying the output on mainPanel whereas the Clear button is for clearing that output. My Clear button isn't working due to some unforeseen reason. Can somebody please have a look at my codes. I shall be extremely grateful.

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)
Doctor
  • 59
  • 1
  • 11

2 Answers2

4

insertUI() and removeUI() is what you might be looking for.

Removing the element is easier with removeUI():

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

To avoid that you dont delete it permanently you could use insertUI():

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

In order to place the element correctly you can use a placeholder in the mainPanel():

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

Then you could remove the dependency of thedata() from the input button, since you use the insertUI() now. (You should swith to insertUI(), because otherwise you cant re-insert the table once its deleted without it,...)

  thedata <- reactive({
     ...
  })

Full example would read:

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)
)
Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
  • Thanks a lot mate, it's a perfect solution. Really grateful :) – Doctor Jan 20 '19 at 10:34
  • small hint, for min reproducible example seven packages is a lot. :) – Tonio Liebrand Jan 20 '19 at 23:14
  • Hi mate, there's a slight problem left in **Go button**. Once go is pressed, and the values of cyl filter are added, the table keeps on changing automatically.. I was hoping that the table would only change when i press Go button. Could you please have a look – Doctor Jan 22 '19 at 09:44
  • you can use `isolate()` for that, see my edit. If there are additional requirements it would be best to transfer that into a new question. Hope that helps,.. – Tonio Liebrand Jan 22 '19 at 10:27
  • Thank you so much mate :) Your a genius – Doctor Jan 22 '19 at 12:22
1

Why not inject some javascript? This way, your code is kept virtually unchanged.

Create a js file in your shiny folder with the following code (rmDt.js in this example):

$("#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();    
});

Save this file and then inject it in your shiny R script:

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))
JdeMello
  • 1,708
  • 15
  • 23
  • 1
    Thanks a lot mate, it's working for this particular data set, but for the other datatset and complex codings which i got, it doesn't work for some reason. Maybe i'm using shinyjs in those codes. Still i'm really thankful for your efforts :) – Doctor Jan 20 '19 at 10:36