rshinydt

How to avoid DT column filters breaking selectizeInputs?


I have a shiny app in which a new tab panel with input elements gets created by a click of a button. There is also a DT object which shows global information and with which elements can be selected and modified with another button (not relevant in example).

The point is: When I activate the column filter in the DT object, the selectizeInput elements in the created tab panel get somehow destroyed.

My app has already multiple layers and to work around is not easy, maybe someone has an answer to this.

Example of added tab without filter:

enter image description here

Example of added tab with filter:

enter image description here

Example:

library(shiny)
library(DT)


ui <- shinyUI(
  navbarPage(title = "Test"
             , id = "tabs"
             , tabPanel("test_panel",
                        mainPanel(
                          actionButton("button_new_tab", "New tab", width = "20%"))
                        , DT::DTOutput("testtable", width = "100%"),
                        width = "100%"
             )
  )
  
  
  
)

server <- function(input, output, session) {
  
  data <- data.frame(a = c(1,2,3), b = c("a","B","c"))
  

  
  observeEvent(input$button_new_tab, {
    
    appendTab(inputId = "tabs", tab = tabPanel("added_tab",
                                               
                                               sidebarLayout(
                                                 sidebarPanel(
                                                   tabPanel("test tab",
                                                            selectizeInput("inp_field", "Test data"
                                                                           , choices = c(a = "a", b = "b", c = "c")
                                                                           , multiple = TRUE))),
                                               
                                                   mainPanel()
                                                 )
                                               )
              )
    
    updateTabsetPanel(session, "tabs",
                      selected = "added_tab")
  })
  
  
  
  output$testtable <- renderDT({
    datatable(data
             # , filter = 'top'    #### comment or uncomment here
              )
  })
}

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

A workaround in this example would be to create the appendTab outside the observeEvent() and hide it. On button click it can be "activated" via showTab(). This would work for this usecase, but this is just a minimal example and my app is more complicated.


Solution

  • You are seeing this behaviour due to a Javascript error Error: Unable to find "selectize-plugin-a11y" plugin which can occur if you use a DT with filter option.

    This is at least similar to a known problem which is currently listed as an open issue on GitHub. However, as discussed there (see the link), a workaround is to include an htmltools::findDependencies on your selectizeInput into your ui. Minimal example below.

    enter image description here

    library(shiny)
    library(DT)
    
    
    ui <- shinyUI(navbarPage(
        title = "Test"
        ,
        id = "tabs"
        ,
        tabPanel(
            "test_panel",
            mainPanel(
                htmltools::findDependencies(selectizeInput(
                    "inp_field", "Test data"
                    , choices = c(a = "a", b = "b", c = "c")
                )),
                actionButton("button_new_tab", "New tab", width = "20%")
            )
            ,
            DT::DTOutput("testtable", width = "100%"),
            width = "100%"
        )
    ))
    
    server <- function(input, output, session) {
        data <- data.frame(a = c(1, 2, 3), b = c("a", "B", "c"))
        
        
        
        observeEvent(input$button_new_tab, {
            appendTab(inputId = "tabs",
                      tab = tabPanel(
                          "added_tab",
                          
                          sidebarLayout(sidebarPanel(
                              tabPanel(
                                  "test tab",
                                  selectizeInput(
                                      "inp_field",
                                      "Test data"
                                      ,
                                      choices = c(a = "a", b = "b", c = "c")
                                      ,
                                      multiple = TRUE,
                                  )
                              )
                          ),
                          
                          mainPanel())
                      ))
            
            updateTabsetPanel(session, "tabs",
                              selected = "added_tab")
        })
        
        
        
        output$testtable <- renderDT({
            datatable(data
                      , filter = 'top')
        })
    }
    
    # Run the application
    shinyApp(ui = ui, server = server)