How to keep values after changing chained selectInputs in shiny in R?
I have a complicated shiny app (here is a simpler example) which looks like that:
The app gives user the possibility to change four parameters (selectInput). The lower parameter depends on the highter one (ex. month on year, type on year and month and so on). Everything works but the fact that when I change one parameter, the other one changes too. It is needed in some situations, but not always. It is needed when the level chosen earlier does not exist in new configuration but for example when I have the following situation it should not be changed. Ex. I chose type 'AGD' and size 'medium' for some year and month and I show the prise or something for this combination. Then I would like to compare it to the same size in type 'RTV' so I change type parameter. Everything works but the size changes to the 'big' while I wanted it still to be 'medium'. I can make another click but what for? It is very inconvenient then...
Do you know how to deal with a problem like that?
I managed to do it for two dependencies using observe and reactive values, but for four dependencies it does not work.
Here is my code:
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "miedium"), 6 + 11))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("year"),
uiOutput("month"),
uiOutput("type"),
uiOutput("size")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
output$year <- renderUI({
year <- data %>%
select(year) %>%
unique()
selectInput("year",
"YEAR",
year$year,
selected = max(year$year))
})
output$month <- renderUI({
month <- data %>%
filter(year == input$year) %>%
select(month) %>%
unique() %>%
arrange()
selectInput("month",
"MONTH",
month$month,
selected = max(month$month))
})
output$type <- renderUI({
type <- data %>%
filter(year == input$year,
month == input$month) %>%
select(type) %>%
unique() %>%
arrange()
selectInput("type",
"TYPE",
type$type,
selected = type$type[1])
})
output$size <- renderUI({
size <- data %>%
filter(year == input$year,
month == input$month,
type == input$type) %>%
select(size) %>%
unique() %>%
arrange()
selectInput("size",
"SIZE",
size$size,
selected = size$size[1])
})
}
shinyApp(ui = ui, server = server)
Issues With the Existing Code
There are a couple of issues with the code here and the solution allows us to introduce the concept of memory into the app. First and foremost there are two issues I would like to address right off the bat.
c("big", "small", "medium", "big", "medium")and notc("big", "small", "medium", "big", "miedium")The
uiOutput()andrenderUI()combination results the server serving a newselectInputbutton, everytime the input is changed. Instead we can simply instantiate a static UI element and update it usingupdateSelectInput()
Solution
To solve this problem lets first fix 1) and 2) described above. Then we need to introduce the concept of memory. The server needs to know what was previously selected, so that we can set it as the default option when the selectInput is updated. We can store this as a regular list (a variable for year, month, type and size) or a reactive list using reactiveValues.
Its great that you have settled on a clear cut logic for the filtering options, there is a clear hierarchy from years-> months -> type -> size. However, everytime months was changed for example a new input was generated for type and size.
We would now like to introduce a simple logic where the input selection only modifies the memory selected_vals. Then a change in memory triggers the other inputs to be updated. This is best seen in the solution below.
Code Solution
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month) displayVal = selected_vals$month else displayVal = NULL
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type) displayVal = selected_vals$type else displayVal = NULL
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size) displayVal = selected_vals$size else displayVal = NULL
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)
Edit
As mentioned in the comment below there is a bug in the code. This is caused by the fact that then displayVal = NULL shiny sets the default value to display as the first element in he array. However we forget to store this in memory, selected_vals. The code below fixes this.
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month){
displayVal = selected_vals$month
}else{
displayVal = NULL
selected_vals$month = month$month[1]
}
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type){
displayVal = selected_vals$type
}else{
displayVal = NULL
selected_vals$type = tpye$type[1]
}
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size){
displayVal = selected_vals$size
} else{
displayVal = NULL
selected_vals$size = size$size[1]
}
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)
- Create a Grouping Column/Variable from other Columns in R
- Specify the height of the bars in the gglikert function in R
- modelsummary modelplot: change linewidth
- How to create a conditional panel using a reactive object that is passed from another module?
- renderHighchart output not displaying in Shiny App
- How can I specify GeoTiff configuration of PixelIsPoint when exporting a raster using R package terra?
- Create a list from a dataframe in R
- Fast way of converting large list to dataframe
- rintrojs only shows first dialog in Safari
- Automatically read a column of lowercases True and False as logical
- How do I add counts to a stacked bar graph?
- Counting the number of rows between each pair of months?
- Plot multiple normalized stock charts from different dates into a single plot
- Select columns based on string match - dplyr::select
- Looking for a more efficient way to replace matrix elements
- custom R function with group argument does not work while using the filter
- ggsurvplot function, risk table alignment problem
- plot running average in ggplot2
- Calling variable in df within function
- How to find position of running minimum (runMin) in a vector in R?
- Using httr2::last_response() in conjunction with purrr::possibly()
- Cropping a raster using terra does not return the expected extent
- Can janitor::clean_names be used on only certain columns in a data frame?
- Efficient way of row binding time series in a data.table, with correctly sorted timestamps
- Defining optional arguments in R when more complex function
- Can I change the cursor in plotly only when hovering over points?
- Issue Loading RStoolbox: "Cannot find proj.db" Error
- Filter CSV files for specific value before importing
- Matching the same lines from 2 different files and 2 columns
- Conditional coloring and outer borders in pdf KableExtra table in R