dropdown menu for a table in shiny

Question

I have "fairly" large data set, with different brands and how they performed through out the years. I would like to create a drop-down menu, where I can access the Brand I want to view from the table. I have tried to emulate the example on this answer.

#Below is a sample data
    data<-structure(list(Date = c("2017-01", "2017-02", "2017-03", "2017-04", 
"2017-05", "2017-06", "2017-07", "2017-08", "2017-09", "2017-10", 
"2017-11", "2017-12", "2018-01", "2018-02", "2018-03", "2018-04", 
"2018-05", "2018-06", "2018-07", "2018-08", "2018-09", "2018-10", 
"2018-11", "2018-12"), `Brand Name` = c("Oreo", "Lindt", "Snickers", 
"OMO", "Oreo", "Lindt", "Snickers", "OMO", "Oreo", "Lindt", "Lindt", 
"Snickers", "OMO", "Oreo", "Lindt", "Snickers", "OMO", "Oreo", 
"Lindt", "Snickers", "OMO", "OMO", "Oreo", "Lindt"), Profit = c(3542.07, 
6024.91, 4739.9, 2344.03, 3294.06, 7478.54, 4482.91, 2760.74, 
4195.26, 6424.08, 7100.65, 5712.05, 2746.28, 5892.93, 9774.93, 
6659.96, 3121.69, 4753.31, 9652.76, 5990.85, 2838.11, 3354.48, 
4495.58, 10483.94)), class = c("spec_tbl_df", "tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -24L), spec = structure(list(
    cols = list(Date = structure(list(), class = c("collector_character", 
    "collector")), `Brand Name` = structure(list(), class = c("collector_character", 
    "collector")), Profit = structure(list(), class = c("collector_double", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), skip = 1), class = "col_spec"))

 #here's what I tried 
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

    status <- match.arg(status)
    # dropdown button content
    html_ul <- list(
        class = "dropdown-menu",
        style = if (!is.null(width))
            paste0("width: ", validateCssUnit(width), ";"),
        lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # dropdown button apparence
    html_button <- list(
        class = paste0("btn btn-", status," dropdown-toggle"),
        type = "button",
        `data-toggle` = "dropdown"
    )
    html_button <- c(html_button, list(label))
    html_button <- c(html_button, list(tags$span(class = "caret")))
    # final result
    tags$div(
        class = "dropdown",
        do.call(tags$button, html_button),
        do.call(tags$ul, html_ul),
        tags$script(
            "$('.dropdown-menu').click(function(e) {
      e.stopPropagation();
});")
    )
}

# app ---------------------------------------------------------------------
library("shiny")
ui <- fluidPage(
    tags$h1("Example dropdown button"),
    br(),
    fluidRow(
        column(
            width = 6,
            dropdownButton(
                label = "Choose Brand", status = "default", width = 80,
                actionButton(inputId = "a2z", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
                actionButton(inputId = "z2a", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
                br(),
                actionButton(inputId = "all", label = "(Un)select all"),
                checkboxGroupInput(inputId = "check2", label = "Choose", choices = data$`Brand Name`)
            ),
            DT::dataTableOutput("table")
        )
    )
)
server <- function(input, output, session) {

    # Sorting asc
    observeEvent(input$a2z, {
        updateCheckboxGroupInput(
            session = session, inputId = "check2", choices = data$`Brand Name`, selected = input$check2
        )
    })
    # Sorting desc
    observeEvent(input$z2a, {
        updateCheckboxGroupInput(
            session = session, inputId = "check2", choices = data$`Brand Name`, selected = input$check2
        )
    })
    output$table <- DT::renderDataTable({
        input$check2
    })
    # Select all / Unselect all
    observeEvent(input$all, {
        if (is.null(input$check2)) {
            updateCheckboxGroupInput(
                session = session, inputId = "check2", selected = data$`Brand Name`
            )
        } else {
            updateCheckboxGroupInput(
                session = session, inputId = "check2", selected = ""
            )
        }
    })
}
shinyApp(ui = ui, server = server)

But when I run this code, it doesn't work. Instead I get the following error "'data' must be 2-dimensional (e.g. data frame or matrix)" when I click on the options of the menu. Also the drop-down menu shows all the entries of the Brand name column but I just want the list of the Brand name(Oreo, Lindt, Snickers, OMO).My knowledge in html and shiny is very basic, any help is greatly appreciated.

What is the table you want to render? `input$check2` is not a dataframe, this is a character string, so `renderDatatable(input$check2)` does not work (this generates the error you get). — Stéphane Laurent, Jul 17 '19 at 10:03
@StéphaneLaurent I would like to render a filtered table with the values I will have selected from the drop down menu. — jb12n, Jul 17 '19 at 11:40
Maybe `renderDatatable(data[data[["Brand Name"]] %in% input$check2,])` ? — Stéphane Laurent, Jul 17 '19 at 14:43
Some parts of the menu are working after changing to what you suggested(although I had to change `renderDatatable` to `renderDataTable`). It is showing the values, once I click on the Brand Name I want. Now, the issue is that the drop-down menu shows all the entries of the Brand name column, I just want the list of the Brand name. Also, the sorting part of the drop-down menu is not working — jb12n, Jul 17 '19 at 15:10

score 1 · Accepted Answer · answered Jul 17 '19 at 21:23

I think its easier just working with Data Frames, you can use as.data.frame() to convert your data and it makes it a little easier to work with. As to the error, it is like others have said, your input is only returning what items have been checked, you have to filter the data based on that. what I did was the following:

output$table <- DT::renderDataTable({
    selectedBrand <- input$check2 # gets selected brands
    temp <- as.data.frame(data) # just reformats the data as dataframe, if your data is large you will want to do this outside runtime
    temp[which(temp$`Brand Name` %in% selectedBrand),] # returns data matching your selected brand
  })

This makes it where you actually filter the data. One other thing I noticed is with your sorting A-Z etc, and with your initial checkbox setup, you can use unique() to get the unique brand names, so there aren't too many choices :) The sorting is easy with the sort() command. Below is attached a working version:

#Below is a sample data
data<-structure(list(Date = c("2017-01", "2017-02", "2017-03", "2017-04", 
                              "2017-05", "2017-06", "2017-07", "2017-08", "2017-09", "2017-10", 
                              "2017-11", "2017-12", "2018-01", "2018-02", "2018-03", "2018-04", 
                              "2018-05", "2018-06", "2018-07", "2018-08", "2018-09", "2018-10", 
                              "2018-11", "2018-12"), `Brand Name` = c("Oreo", "Lindt", "Snickers", 
                                                                      "OMO", "Oreo", "Lindt", "Snickers", "OMO", "Oreo", "Lindt", "Lindt", 
                                                                      "Snickers", "OMO", "Oreo", "Lindt", "Snickers", "OMO", "Oreo", 
                                                                      "Lindt", "Snickers", "OMO", "OMO", "Oreo", "Lindt"), Profit = c(3542.07, 
                                                                                                                                      6024.91, 4739.9, 2344.03, 3294.06, 7478.54, 4482.91, 2760.74, 
                                                                                                                                      4195.26, 6424.08, 7100.65, 5712.05, 2746.28, 5892.93, 9774.93, 
                                                                                                                                      6659.96, 3121.69, 4753.31, 9652.76, 5990.85, 2838.11, 3354.48, 
                                                                                                                                      4495.58, 10483.94)), class = c("spec_tbl_df", "tbl_df", "tbl", 
                                                                                                                                                                     "data.frame"), row.names = c(NA, -24L), spec = structure(list(
                                                                                                                                                                       cols = list(Date = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                      "collector")), `Brand Name` = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                "collector")), Profit = structure(list(), class = c("collector_double", 
                                                                                                                                                                                                                                                                                                                                    "collector"))), default = structure(list(), class = c("collector_guess", 
                                                                                                                                                                                                                                                                                                                                                                                          "collector")), skip = 1), class = "col_spec"))

#here's what I tried 
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

  status <- match.arg(status)
  # dropdown button content
  html_ul <- list(
    class = "dropdown-menu",
    style = if (!is.null(width))
      paste0("width: ", validateCssUnit(width), ";"),
    lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
  )
  # dropdown button apparence
  html_button <- list(
    class = paste0("btn btn-", status," dropdown-toggle"),
    type = "button",
    `data-toggle` = "dropdown"
  )
  html_button <- c(html_button, list(label))
  html_button <- c(html_button, list(tags$span(class = "caret")))
  # final result
  tags$div(
    class = "dropdown",
    do.call(tags$button, html_button),
    do.call(tags$ul, html_ul),
    tags$script(
      "$('.dropdown-menu').click(function(e) {
      e.stopPropagation();
});")
    )
  }

# app ---------------------------------------------------------------------
library("shiny")
ui <- fluidPage(
  tags$h1("Example dropdown button"),
  br(),
  fluidRow(
    column(
      width = 6,
      dropdownButton(
        label = "Choose Brand", status = "default", width = 80,
        actionButton(inputId = "a2z", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
        actionButton(inputId = "z2a", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
        br(),
        actionButton(inputId = "all", label = "(Un)select all"),
        checkboxGroupInput(inputId = "check2", label = "Choose", choices = unique(data$`Brand Name`))
      ),
      DT::dataTableOutput("table")
    )
  )
)
server <- function(input, output, session) {

  # Sorting asc
  observeEvent(input$a2z, {
    updateCheckboxGroupInput(
      session = session, inputId = "check2", choices = sort(unique(data$`Brand Name`)), selected = input$check2
    )
  })
  # Sorting desc
  observeEvent(input$z2a, {
    updateCheckboxGroupInput(
      session = session, inputId = "check2", choices = sort(unique(data$`Brand Name`), decreasing = T), selected = input$check2
    )
  })
  output$table <- DT::renderDataTable({
    selectedBrand <- input$check2 # gets selected brands
    temp <- as.data.frame(data) # just reformats the data as dataframe, if your data is large you will want to do this outside runtime
    temp[which(temp$`Brand Name` %in% selectedBrand),] # returns data matching your selected brand
  })
  # Select all / Unselect all
  observeEvent(input$all, {
    if (is.null(input$check2)) {
      updateCheckboxGroupInput(
        session = session, inputId = "check2", selected = unique(data$`Brand Name`)
      )
    } else {
      updateCheckboxGroupInput(
        session = session, inputId = "check2", selected = ""
      )
    }
  })
}
shinyApp(ui = ui, server = server)

Good Luck! :)

dropdown menu for a table in shiny

1 Answers1

Linked