How to keep values after changing chained selectInputs in shiny in R? - r

Question

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)

Answer 1

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 not c("big", "small", "medium", "big", "miedium")
The uiOutput() and renderUI() combination results the server serving a new selectInput button, everytime the input is changed. Instead we can simply instantiate a static UI element and update it using updateSelectInput()
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)