В настоящее время у меня есть приложение Shiny с 3 меню (еще будет добавлено после устранения ошибок).
Я нашел в Интернете примеры фильтрации меню сверху вниз. То есть пользователь должен выбрать из первого меню, затем второго меню и т. Д., Но по порядку. Если они сначала выбирают из 2-го меню, то оно не фильтрует первое меню, а только те, которые находятся под ним, и, очевидно, это проблема.
Я хочу, чтобы мои пользователи могли переходить к меню в любом порядке и фильтровать их.
В моем примере есть 3 меню, и я пытаюсь сделать следующее: если observeEvent в любом меню (пользователь делает выбор из любого меню), то:
- Фильтрация данных на основе сделанного выбора.
updateSelectInput для любых меню, которые еще не выбраны,
Это обеспечит актуальность меню в соответствии с тем, что на самом деле находится в данных, и гарантирует, что пользователь не урезает что-то, чего на самом деле нет в данных.
Кроме того, обратите внимание , что шаг # 2 очень важен - обновлять только меню без выбора, у меня были проблемы с этим, потому что, если я просто обновляю все остальные меню, он очищает выбранный пользователем ввод, который все еще неправильное поведение.
Я знаю, что мне нужно сделать, но мне пока не удалось это сделать, поэтому помощь приветствуется.
Обновление
Я обновил свой код для работы с одним ответом, опубликованным ниже, но он все еще не совсем корректно работает.
Теперь он выполняет фильтрацию меню, однако после создания подмножества он не позволяет ему «отфильтровывать» резервные копии.
Под этим я подразумеваю, что если я выберу значение 3 в первом меню TreeNumber, то последнее меню отфильтруется до значения 300 - это хорошо. НО Если я затем вернусь в первое меню и также выберу значение 4, я ожидаю, что в меню Circumference появятся значения: 300 и 400, однако по-прежнему показывает только значение 300.
Обновленный код:
d <- data.frame("TreeNumber" = c(replicate(7, 1), replicate(7, 2),
replicate(7, 3), replicate(7, 4)),
"TreeAge" = c(1:28),
"Circumference" = c(replicate(7, 100), replicate(7, 200),
replicate(7, 300), replicate(7, 400)))
col_names <- names(d)
# TODO - change these to: "Tree Number", "Tree Age", "Circumference"
user_friendly_names <- c('TreeNumber', 'TreeAge', 'Circumference')
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Filters:"),
uiOutput("filters"),
# Plot button
fluidRow(column(2, align = "right",
actionButton("plot_graph_button", "Plot")))
),
mainPanel(tableOutput("summary"))
)
)
server <- function(input, output, session) {
#### Create the filter lists for UI ####
output$filters <- renderUI({
if(is.null(col_names)) return(NULL)
lapply(1:length(col_names), function(i) {
col <- paste0(col_names[i])
alias <- user_friendly_names[i]
# Populate input with unique values from column
pickerInput(inputId = alias, label = paste(alias,':'),
choices = unique(d[[col]]), multiple = T)
})
})
# lapply(X = vars, FUN = function(x) {
# vals <- sort(unique(data[[x]]))
# updatePickerInput(session = session, inputId = x, choices = vals)
# })
my_filter <- function(data, var) {
# TODO - Need to convert from user_friendly_names --> col_names in here
if (length(input[[var]]) == 0) return(data)
data %>% subset(data[[var]] %in% input[[var]])
}
subsettedData <- reactive({
d %>% my_filter("TreeNumber") %>% my_filter("TreeAge") %>%
my_filter("Circumference")
# TODO - get into for loop versus hard coding this step:
# for(z in 1:length(col_names)){
# d %>% my_filter(col_names[z])
# }
})
observeEvent(subsettedData(), {
lapply(col_names, function(var) {
selections <- unique(subsettedData()[[var]])
if (length(input[[var]]) == 0)
updatePickerInput(session = session, inputId = var, choices = selections)
})
})
observeEvent(input$plot_graph_button, {
for (j in seq_along(d)) {
updateSelectInput(session = session, inputId = user_friendly_names[j],
choices = c("All", unique(d[[j]])), selected = "All")
}
})
output$summary <- renderTable({
# Do not show a plot when the page first loads
# Wait until the user clicks "Plot" button
if (input$plot_graph_button == 0){
return()
}
# Update code below everytime the "Plot" button is clicked
input$plot_graph_button
isolate({
# Fresh copy of the full data set every time "Plot" button is clicked
d <- copy(Orange)
# Filter data based on UI
for(f in 1:length(col_names)){
if(eval(parse(text = paste0('is.null(input$',user_friendly_names[f],')')))){
# Default to "All" - do not filter
print("All")
}else{
d <- d[d[[col_names[f]]] ==
unlist(eval(parse(text =
paste0('input$',user_friendly_names[f])))), ]
}
}
final_summary_table <<- d
})
})
}
shinyApp(ui = ui, server = server)