闪亮的表格的下拉菜单 [英] dropdown menu for a table in shiny
本文介绍了闪亮的表格的下拉菜单的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我拥有相当庞大的数据集，其中包含不同的品牌以及这些年来的表现。我想创建一个下拉菜单，从中可以访问要从表中查看的品牌。我试图在 answer 上模拟该示例。
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)
但是当我运行这段代码时，它不起作用。当我点击菜单上的选项时，出现以下错误数据必须是二维的（例如，数据框或矩阵）。下拉菜单还显示了品牌名称列的所有条目，但我只想要品牌名称列表（Oreo，Lindt，Snickers，OMO）。我对html和Shiny的了解非常基础，对您的帮助非常感谢
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.
推荐答案
我认为仅使用数据框架会更容易，您可以使用 as.data.frame （）来转换您的数据，这样操作起来会更容易一些。至于错误，就像其他人所说的那样，您的输入仅返回已检查的项目，您必须基于此过滤数据。我所做的是以下操作：
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
})
这使它成为您实际过滤数据的地方。
我注意到的另一件事是您的排序AZ等，以及初始复选框的设置，您可以使用 unique（）来获得唯一的品牌名称，因此没有太多选择：)使用 sort（）命令可以很容易地进行排序。以下是工作版本：
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)
祝你好运！ ：）
这篇关于闪亮的表格的下拉菜单的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
