R shiny Drop down list for columns in rendered table

Question

I am trying to create a drop down list to view the values within each column, similar to in excel. But I am unable to create the dropdown list. I am unable to understand where to make changes to create this list. Any suggestions, highly appreciated.

code:

Server.R

library(shiny)
library(DT)

shinyServer(function(input, output, session) {

  mtcars2 = data.frame(
    name = rownames(mtcars), mtcars[, c('mpg', 'hp')],
    stringsAsFactors = FALSE
  )
 
  output$tbl = DT::renderDataTable(
    mtcars2, filter = 'top', server = TRUE, rownames = FALSE,
    options = list(autoWidth = TRUE)
  )
})

ui.r

library(shiny)

shinyUI(fluidPage(
  title = 'Column Filters on the Server Side',
  fluidRow(
    DT::dataTableOutput('tbl')
  )
))

Answer 1

Try this.

library(shiny)
library(DT)

dat <- mtcars

sketch <- htmltools::tags$table(
  tableHeader(c("", names(dat))),
  tableFooter(rep("", 1+ncol(dat)))
)

js <- c(
  "function(){", 
  "  this.api().columns().every(function(i){",
  "    var column = this;",
  "    var select = $('<select><option value=\"\"></option></select>')",
  "      .appendTo( $(column.footer()).empty() )", 
  "      .on('change', function(){",
  "        select.val(null);",
  "      });",
  "    var data = column.data();",
  "    if(i == 0){",
  "      data.each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }else{",
  "      data.unique().sort().each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }",
  "    select.select2({width: '100%'});",
  "  });",
  "}")


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
  ),
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session){
  output[["dtable"]] <- renderDT({
    datatable(
      dat, container=sketch, 
      options = list(
        initComplete = JS(js),
        columnDefs = list(
          list(targets = "_all", className = "dt-center")
        )
      )
    )
  }, server = FALSE)
}

shinyApp(ui, server)

---

Edit: dropdowns at the top of the table

library(shiny)
library(DT)
library(htmltools)

dat <- mtcars

sketch <- tags$table(
  tags$thead(
    tags$tr(
      tags$th(),
      lapply(names(dat), tags$th)
    ),
    tags$tr(
      tags$th(id = "th0"),
      tags$th(id = "th1"),
      tags$th(id = "th2"),
      tags$th(id = "th3"),
      tags$th(id = "th4"),
      tags$th(id = "th5"),
      tags$th(id = "th6"),
      tags$th(id = "th7"),
      tags$th(id = "th8"),
      tags$th(id = "th9"),
      tags$th(id = "th10"),
      tags$th(id = "th11")
    )
  )
)

js <- c(
  "function(){", 
  "  this.api().columns().every(function(i){",
  "    var column = this;",
  "    var select = $('<select><option value=\"\"></option></select>')",
  "      .appendTo( $('#th'+i).empty() )", 
  "      .on('change', function(){",
  "        select.val(null);",
  "      });",
  "    var data = column.data();",
  "    if(i == 0){",
  "      data.each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }else{",
  "      data.unique().sort().each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }",
  "    select.select2({width: '100%'});",
  "  });",
  "}")


ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
  ),
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session) {
  output[["dtable"]] <- renderDT({
    datatable(
      dat, container=sketch, 
      options = list(
        orderCellsTop = TRUE,
        initComplete = JS(js),
        columnDefs = list(
          list(targets = "_all", className = "dt-center")
        )
      )
    )
  }, server = FALSE)
}

shinyApp(ui, server)