我拥有“相当”大数据集，其中包含不同的品牌以及这些年来的表现。我想创建一个下拉菜单，从中可以访问要查看的品牌。我试图在此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的了解非常基础，对您的帮助非常感谢
答案 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)
祝你好运！ ：）