Dynamic creating of selectizeInput (multiple = T) in DT table issue

[tomasreigl]

Hello shiny people,

I wanted to dynamically create a table with some widgets inside. Buttons, textInputs and other were OK, but when I was trying to use selectizeInput with option 'multiple = T' (multiple=F is OK) I found some issues. I'll give you three working examples to describe my workflow, problems and solution. Maybe there is some other and cleaner way to do this. (Don't get confused by "filling output" in observe function, in the end it should make sense)

The first code is definitely working, but the widget is ugly with "selectInput(..., selectize = F)" like style:

library(shiny)
library(DT)

ui <- fluidPage(
    fluidRow(
        actionButton(inputId = "redraw",
                     label = "redraw")
        ),
    DT::dataTableOutput('my_table')
)

server <- function(session, input, output){
    observeEvent(input$redraw, {
        output$my_table <- DT::renderDataTable({
            a <- data.frame(matrix(runif(20),nrow=5))
            a$rearrangements <- sapply(paste0("selectize", 1:5), function(x) as.character(selectizeInput(x, NULL, choices=list("all" = "","incomple","A","B"),selected = "",multiple = T)))
            a <- datatable(a,
                           escape = F,
                           options = list(paging = FALSE, ordering = FALSE, searching = FALSE, 
                                          preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node());}'),
                                          drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
            )
            return(a)
        })
    }, ignoreNULL = FALSE)

    observeEvent(input$selectize1, {
        cat(paste("debug message selectize1:", input$selectize1, "\n"),file = stderr())
    })
}

shinyApp(ui, server)

As I understood, the selectInput widget is modified by renderUI function to selectizeInput, so I tried to solve it by this workaround, but it is not working properly if you recreate the table (by pressing the 'redraw' button):

library(shiny)
library(DT)

ui <- fluidPage(
    fluidRow(
        actionButton(inputId = "redraw",
                     label = "redraw")
        ),
    DT::dataTableOutput('my_table')
)

server <- function(session, input, output){
    observeEvent(input$redraw, {
        output$my_table <- DT::renderDataTable({
            a <- data.frame(matrix(runif(20),nrow=5))
            a$rearrangements <- sapply(paste0("selectize_wrap", 1:5), function(x) as.character(uiOutput(x)))
            a <- datatable(a,
                           escape = F,
                           options = list(paging = FALSE, ordering = FALSE, searching = FALSE, 
                                          preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node());}'),
                                          drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
            )
            return(a)
        })
        # rendering fancy selectize widgets
        for (i in 1:5) {
            subs_widget <- substitute({selectizeInput(paste0("selectize",i), NULL, choices=list("all" = "","incomple","A","B"),selected = "",multiple = T)
            }, list(i = i))
            output[[paste0("selectize_wrap",i)]] <- renderUI(subs_widget, quoted = T)
        }
    }, ignoreNULL = FALSE)

    observeEvent(input$selectize1, {
        cat(paste("debug message selectize1:", input$selectize1, "\n"),file = stderr())
    })
}

shinyApp(ui, server)

Redrawing is working for all other widgets, because it is using:

preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }

But the Callbacks can't find the selectizeInput widgets since they are not existing in that time, so I had to add my own JS function to unbind the widgets really before the table is created:

library(shiny)
library(DT)

ui <- fluidPage(
    fluidRow(
        tags$head(
            tags$script('
                        Shiny.addCustomMessageHandler("unbinding_table_elements", function(x) {                
                        Shiny.unbindAll($(document.getElementById(x)).find(".dataTable"));
                        });'
            )
        ),
        actionButton(inputId = "redraw",
                     label = "redraw")
        ),
    DT::dataTableOutput('my_table')
)

server <- function(session, input, output){
    observeEvent(input$redraw, {
        session$sendCustomMessage(type = "unbinding_table_elements", "my_table")
        output$my_table <- DT::renderDataTable({
            a <- data.frame(matrix(runif(20),nrow=5))
            a$rearrangements <- sapply(paste0("selectize_wrap", 1:5), function(x) as.character(uiOutput(x)))
            a <- datatable(a,
                           escape = F,
                           options = list(paging = FALSE, ordering = FALSE, searching = FALSE, 
                                          preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node());}'),
                                          drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
            )
            return(a)
        })
        # rendering fancy selectize widgets
        for (i in 1:5) {
            subs_widget <- substitute({selectizeInput(paste0("selectize",i), NULL, choices=list("all" = "","incomple","A","B"),selected = "",multiple = T)
            }, list(i = i))
            output[[paste0("selectize_wrap",i)]] <- renderUI(subs_widget, quoted = T)
        }
    }, ignoreNULL = FALSE)

    observeEvent(input$selectize1, {
        cat(paste("debug message selectize1:", input$selectize1, "\n"),file = stderr())
    })
}

shinyApp(ui, server)

This solution is working, but is there any cleaner (i.e. without my own JS) way to do it? Or should be the selectizeInput creation changed inside the Shiny?

Thank you for all your reactions!

[bborgesr]

Note to self: related to #1214

[mammask]

hi, do you remember how did you obtain information from the table?

[ismirsehregal]

Recently a related question came up on SO. I would be very grateful if someone could explain what is going wrong using Shiny.bindAll / Shiny.unbindAll in this case.