The dropdown list is not responding properly in DT table (Shiny)

Question

i am developing the app with DT table. One of the column must contain the dropdown list.

Upon the selection of the value from the list i want to update the string output. As an example i am using the instance of the shiny app from here. The example works fine but not locally.

When i am running the app on my laptop the app works without errors but the string output is not being updated upon the click on the dropdown list.

I am at loss what is going wrong. I have tried other example but the outcome is the same - no updates upon the click on the dropdown list.

I would be grateful if someone could make a hint.

My App:

`   library(shiny)
    library(DT)

    ui <- fluidPage(
      title = 'Selectinput column in a table',
      h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
      DT::dataTableOutput('foo'),
      verbatimTextOutput('sel')
    )

    server <- function(input, output, session) {
      data <- head(iris, 5)
  
      for (i in 1:nrow(data)) {
        data$species_selector[i] <- as.character(selectInput(paste0("sel", i), "", choices =    unique(iris$Species), width = "100px"))
    }
  
      output$foo = DT::renderDataTable(
        data, escape = FALSE, selection = 'none', server = FALSE,
        options = list(dom = 't', paging = FALSE, ordering = FALSE),
        callback = JS("table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
    )
  
    output$sel = renderPrint({
      str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
    })
    }

    shinyApp(ui, server)`

My environment settings: > sessionInfo() R version 4.2.1 (2022-06-23 ucrt) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19045)

Matrix products: default

locale:
[1] LC_COLLATE=Ukrainian_Ukraine.utf8  LC_CTYPE=Ukrainian_Ukraine.utf8   
[3] LC_MONETARY=Ukrainian_Ukraine.utf8 LC_NUMERIC=C                      
[5] LC_TIME=Ukrainian_Ukraine.utf8    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] data.table_1.15.0 DT_0.32           shiny_1.8.0      

loaded via a namespace (and not attached):
[1] Rcpp_1.0.12       rstudioapi_0.15.0 magrittr_2.0.3    xtable_1.8-4      R6_2.5.1         
[6] rlang_1.1.3       fastmap_1.1.1     tools_4.2.1       cli_3.6.1         jquerylib_0.1.4  
[11] withr_3.0.0       crosstalk_1.2.1   htmltools_0.5.7   ellipsis_0.3.2    yaml_2.3.8       
[16] digest_0.6.34     lifecycle_1.0.4   crayon_1.5.2      later_1.3.2       sass_0.4.8       
[21] htmlwidgets_1.6.4 promises_1.2.1    memoise_2.0.1     cachem_1.0.8      mime_0.12        
[26] compiler_4.2.1    bslib_0.6.1       jsonlite_1.8.8    httpuv_1.6.14    

Answer 1

There are two possibilities:

• you set selectize = FALSE in selectInput (it is TRUE by default) and then you just have to add the options preDrawCallback and drawCallback as in the app below;
• or you keep selectize = TRUE but then you also have to include the HTML dependencies (the selectize JavaScript library) in your app, and you have to initialize the dropdown lists by calling the selectize() method in the option initComplete; this is what I do in the app below

The dropdown lists are more stylish with selectize = TRUE. Moreover it is possible to include some options in the call to the selectize() method.

library(shiny)
library(DT)

# this selectInput will not be included in the app;
# we just use it to extract the required HTML dependencies
select_input <- selectInput("x", label = NULL, choices = c("A", "B"))
deps <- htmltools::findDependencies(select_input)
# now you just have to include tagList(deps) somewhere in the Shiny UI

ui <- fluidPage(
  title = 'Selectinput column in a table',
  DTOutput('foo'),
  verbatimTextOutput('sel'),
  tagList(deps)
)


server <- function(input, output, session) {
  
  data <- head(iris, 5)
  
  for (i in 1:nrow(data)) {
    data$species_selector[i] <- 
      as.character(
        selectInput(
          paste0("sel", i), "", 
          choices = unique(iris$Species), 
          width = "100px"
        )
      )
  }
  
  output$foo = renderDT({
    datatable(
      data, escape = FALSE, selection = 'none', 
      options = list(
        dom = 't', 
        paging = FALSE, 
        ordering = FALSE,
        initComplete = JS(c(
          "function(settings, json) {",
          "  var $table = this.api().table().node().to$();",
          "  $table.find('[id^=sel]').selectize();", # apply selectize() to all elements whose id starts with 'sel' (here sel1, sel2, ...)
          "}"
        )),
        preDrawCallback = 
          JS("function() {Shiny.unbindAll(this.api().table().node());}"),
        drawCallback 
        = JS("function() {Shiny.bindAll(this.api().table().node());}")
      )  
    )
  })

  output$sel = renderPrint({
    str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
  })
}

shinyApp(ui, server)