我希望能够在 Shiny 的 UI 输入中根据用户之前的选择更新自己。因此在下面的示例中,预期的行为是用户从 cyl
、vs
或 carb
中进行选择
- 过滤数据集
mtcars
用于创建绘图,即用户根据过滤条件调整绘图 - 更新其他过滤器中剩余的输入选项,以便与基于已有过滤器的剩余选择相对应。
这是我尝试过的:
library(shiny)
library(dplyr)
library(plotly)
data("mtcars")
# create ui
ui <- fluidPage(
fluidRow(
box(
title = "Filter",
uiOutput(outputId = "cyl_dynamic_input"),
uiOutput(outputId = "vs_dynamic_input"),
uiOutput(outputId = "carb_dynamic_input")
),
box(
title = "Plot of mtcars",
plotlyOutput("carplot")
)
),
)
# create server
server <- function(input, output, session) {
# create reactive filters of the mtcars table
mtcars.reactive <-
reactive({
mtcars %>%
filter(mpg %in% input$cyl_input_rendered &
vs %in% input$vs_input_rendered &
carb %in% input$carb_input_rendered
)})
## create rendered inputs
# for cyl
output$cyl_dynamic_input <- renderUI({
pickerInput(inputId = "cyl_input_rendered",
label = "CYL",
choices = unique(mtcars$cyl),
multiple = T,
selected = mtcars.reactive()$cyl,
options = list(
`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} out of {1} cyl selected"
))
})
# for vs
output$vs_dynamic_input <- renderUI({
pickerInput(inputId = "vs_input_rendered",
label = "VS",
choices = unique(mtcars$vs),
multiple = T,
selected = mtcars.reactive()$vs,
options = list(
`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} out of {1} vs selected"
))
})
# for carb
output$carb_dynamic_input <- renderUI({
pickerInput(inputId = "carb_input_rendered",
label = "CARB",
choices = unique(mtcars$carb),
multiple = T,
selected = mtcars.reactive()$carb,
options = list(
`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} out of {1} carb selected"
))
})
## create the plot output
# Start Barplot Emissionen here
output$carplot<-
renderPlotly({
# create plot
plot<-ggplot(mtcars.reactive(), aes(wt, mpg))+
geom_point()
# convert to plotly
ggplotly(plot)
})
}
shinyApp(ui, server)
我的猜测是这无法工作,因为 mtcars
表的过滤器引用了渲染的输入,反之亦然,这以某种方式创建了一个空的信息循环
我已经在 official Shiny documentation 中看过了它还提供了一些background information但是整个主题对于初学者来说并不是很直观。这是一个不知何故 similar question但它不能完全重现。
最佳答案
下面的代码没有层次结构,而是在 observeEvent
语句中使用 pickerInput
和条件语句来执行您想要的操作。起初看起来很复杂,但它做了它应该做的事情。
library(shiny)
library(dplyr)
library(plotly)
data("mtcars")
# create ui
ui <- fluidPage(fluidRow(
box(
title = "Filter",
pickerInput(
inputId = "cyl_pickerinput",
label = "CYL",
choices = levels(as.factor(mtcars$cyl)),
multiple = T,
selected = levels(as.factor(mtcars$cyl)),
options = list(
`live-search` = TRUE,
#`actions-box` = TRUE,
`selected-text-format` = "count",
`count-selected-text` = "{0} out of {1} cyl selected"
)
),
pickerInput(
inputId = "vs_pickerinput",
label = "VS",
choices = levels(as.factor(mtcars$vs)),
multiple = T,
selected = levels(as.factor(mtcars$vs)),
options = list(
`live-search` = TRUE,
#`actions-box` = TRUE,
`selected-text-format` = "count",
`count-selected-text` = "{0} out of {1} vs selected"
)
),
pickerInput(
inputId = "carb_pickerinput",
label = "CARB",
choices = levels(as.factor(mtcars$carb)),
multiple = T,
selected = levels(as.factor(mtcars$carb)),
options = list(
`live-search` = TRUE,
#`actions-box` = TRUE,
`selected-text-format` = "count",
`count-selected-text` = "{0} out of {1} carb selected"
)
),
),
box(title = "Plot of mtcars",
plotlyOutput("carplot"))
),)
# create server
server <- function(input, output, session) {
#(1) Create PickerInput Updates
observeEvent(
# define pickerinputs to be observed
c(
input$vs_pickerinput,
input$carb_pickerinput,
input$cyl_pickerinput
),
{
## filter the data based on the pickerinputs
# include an ifelse condition first to check wheter at least one value is choosen in all of the filters.
mtcars2 <-
if (!is.null(input$cyl_pickerinput) &
!is.null(input$vs_pickerinput) &
!is.null(input$carb_pickerinput)) {
mtcars %>%
filter(cyl %in% input$cyl_pickerinput) %>% # filters
filter(vs %in% input$vs_pickerinput) %>%
filter(carb %in% input$carb_pickerinput)
}
else{
mtcars
}
## update PickerInput based on a condition that requires the user to choose at least one input, else reset all filters
# for cyl
if (!is.null(input$cyl_pickerinput)) {
updatePickerInput(
session,
"cyl_pickerinput",
choices = levels(factor(mtcars$cyl)),
selected = unique(mtcars2$cyl))
} else{
}
# for carb
if (!is.null(input$carb_pickerinput)) {
updatePickerInput(
session,
"carb_pickerinput",
choices = levels(factor(mtcars$carb)),
selected = unique(mtcars2$carb)
)
}
# for vs
if (!is.null(input$vs_pickerinput)) {
updatePickerInput(
session,
"vs_pickerinput",
choices = levels(factor(mtcars$vs)),
selected = unique(mtcars2$vs)
)
}
},
ignoreInit = TRUE,
ignoreNULL = F
)
# (2) Create reactive object with filtered data
# update mtcars table based on filters
mtcars.reactive <-
reactive({
if (!is.null(input$vs_pickerinput))
# one condition should be enough.
{
mtcars %>% # filters
filter(
cyl %in% input$cyl_pickerinput &
vs %in% input$vs_pickerinput &
carb %in% input$carb_pickerinput
)
} else
{
mtcars
}
})
# (3) create the plot output
output$carplot <-
renderPlotly({
# create plot
plot <- ggplot(mtcars.reactive()) +
geom_point(aes(wt, mpg, color = factor(vs)))
# convert to plotly
ggplotly(plot)
})
}
shinyApp(ui, server)
关于r - Shiny 的多个动态过滤器更新,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/62827451/