I'm developping an R Shiny-based application. I want to keep my input consistent with available data, thus I update the selected values in selectInput. When I change selected value in input 1, then the value of input 2 is updated, then the data is updated (just once). OK BUT if I change selected value in input 2, then the data is updated, then the value of input 1 is updated, then the data is updated AGAIN. Check out the "check latest_value" that is printed twice.
Initially I used renderUI rather than updateSelectInput, but at initialisation, the data is computed twice.
library(shiny)
library(DT)
library(dplyr)
my_data=data.frame(CO2)
# Running a Shiny app object
app <- shinyApp(
ui = bootstrapPage(
selectInput('type','Choix du type',choices = unique(my_data$Type)),
uiOutput('plant_ui'),
DTOutput('plot')
),
server = function(input, output) {
data=reactive({
# req(input$type)
my_data_temp=my_data
if(length(input$type)>0){
my_data_temp=my_data_temp%>%filter(Type%in%input$type)
}
if(length(input$plant)>0){
my_data_temp=my_data_temp%>%filter(Plant%in%input$plant)
}
my_data_temp
})
latest_plant_value=reactive({
if(is.null(input$plant))data()$Plant[1]
else input$plant
})
output$plant_ui=renderUI({
sub_data=data()
selectInput(inputId = 'plant',"filtre par plant",choices = unique(sub_data$Plant),
selected=latest_plant_value())
})
output$plot <- renderDT({
print("check latest_value")
datatable(data()) })
}
)
runApp(app)
That's why I decided to use updateSelectInput based on this Alternate control of a sliderInput between a derived value and user selected value but the sequential structure of the code makes the data to be computed twice when I change input 2 value.
library(shiny)
library(DT)
library(dplyr)
my_data=data.frame(CO2)
# Running a Shiny app object
app <- shinyApp(
ui = bootstrapPage(
selectInput('type','Choix du type',choices = unique(my_data$Type),selected=my_data$Type[1]),
selectInput('plant','Choix du type',choices = unique(my_data$Plant),selected=my_data$Plant[1]),
DTOutput('plot')
),
server = function(input, output,session) {
data=reactive({
# req(input$type)
my_data_temp=my_data
if(length(input$type)>0){
my_data_temp=my_data_temp%>%filter(Type%in%input$type)
}
if(length(input$plant)>0){
my_data_temp=my_data_temp%>%filter(Plant%in%input$plant)
}
my_data_temp
})
observeEvent(input$type,{
print("update type changed")
updateSelectInput(session, "plant",
selected = unique(my_data%>%filter(Type%in%input$type)%>%.$Plant)[1])
})
observeEvent(input$plant,{
print("update plant changed")
updateSelectInput(session, "type",
selected = unique(my_data%>%filter(Plant%in%input$plant)%>%.$Type)[1])
})
output$plot <- renderDT({
print("check latest_value")
datatable(data()) })
}
)
runApp(app)
Fixes like this one don't work in that case because I'm not trying to achieve the same thing three interdependent selectInput in R/Shiny application
I want the default selected value of each input to be consistent so that the filter returns at least 1 value. This of any input I change.
Interesting problem and not easy to solve! Interestingly, what you are asking for is not what you need. Observation:
The solution therefore is twofold:
See the result below. Watch the console output to observe the decisions.
library(shiny)
library(DT)
library(dplyr)
my_data=data.frame(CO2)
shinyApp(
ui = bootstrapPage(
selectInput('type','Choix du type',choices = unique(my_data$Type),selected=my_data$Type[1]),
selectInput('plant','Choix du plant',choices = unique(my_data$Plant),selected=my_data$Plant[1]),
DTOutput('plot')
),
server = function(input, output,session) {
latest_data <- reactiveVal(my_data)
observe({
result <- my_data %>% filter(Type %in% input$type, Plant %in% input$plant)
if(nrow(result) > 0){
latest_data(result)
}else{
cat(format(Sys.time(), "%H:%M:%S"), "Didn't update the dataframe because the choice was not valid.\n")
}
})
observeEvent(input$type,{
if(! input$plant %in% my_data$Plant[my_data$Type == input$type]){
old <- input$plant
new <- my_data %>% filter(Type %in% input$type) %>% slice(1) %>% pull(Plant) %>% as.character()
updateSelectInput(session, "plant", selected = new)
cat(format(Sys.time(), "%H:%M:%S"), "Updated input$plant from", old, "to", new, "so that it represents a valid choice for", input$type, "\n")
}else{
cat(format(Sys.time(), "%H:%M:%S"), "Didn't update input$plant", input$plant, "because it is a valid choice for", input$type, "already\n")
}
})
observeEvent(input$plant,{
updateSelectInput(session, "type",
selected = my_data %>% filter(Plant %in% input$plant) %>% slice(1) %>% pull(Type))
})
output$plot <- renderDT({
cat(format(Sys.time(), "%H:%M:%S"), "updating datatable to only include", isolate(input$plant), "and", isolate(input$type), "\n\n")
latest_data()
datatable(latest_data())
})
}
)