Reputation: 3039
I want to be able to have UI inputs in shiny that update themselves based on the previous choices of a user. So in the example below, the intended behavior would be that the user chooses from cyl
, vs
or carb
which will then
mtcars
which is used to create a plot i.e. the user adjusts the plot to the filter criteria andHere is what I tried:
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)
My guess is that the this cannot work because the filter for the mtcars
table references to the rendered inputs and vice versa which somehow creates an empty information loop
I already had a look in the official Shiny documentation which also provides some background information but the whole topic is not really intuitiv for a beginner. Here is a somehow similar question but it is not fully reproducible.
Upvotes: 4
Views: 2341
Reputation: 1982
The following does what you want without a hierarchy but using pickerInput
and conditional statements in an observeEvent
statement. It looks complex at first but does what it should do.
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)
Upvotes: 2