闪亮的表格的下拉菜单

时间：2019-07-17 09:58:59

标签： html r drop-down-menu shiny

我拥有“相当”大数据集，其中包含不同的品牌以及这些年来的表现。我想创建一个下拉菜单，从中可以访问要查看的品牌。我试图在此GlobalPlatformPro上模拟该示例。 

#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)

但是当我运行这段代码时，它不起作用。当我单击菜单选项时，出现以下错误“'数据'必须是二维的（例如，数据框或矩阵）”。下拉菜单还显示了“品牌名称”列的所有条目，但我只想要品牌名称列表（Oreo，Lindt，Snickers，OMO）。我对html和Shiny的了解非常基础，对您的帮助非常感谢

1 个答案:

答案 0 :(得分：1)

我认为仅使用数据框架会更容易，您可以使用as.data.frame()来转换数据，并且使用起来会更容易。对于错误，就像其他人所说的那样，您的输入仅返回已检查的项目，您必须基于此过滤数据。我所做的是：

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
  })

这使它成为您实际过滤数据的地方。 我注意到的另一件事是您的排序AZ等，以及您初始的复选框设置，您可以使用unique()来获得唯一的品牌名称，因此选择的可能性不是很多：) sort()命令。以下是工作版本：

#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)

祝你好运！ ：）

相关问题
最新问题