Update selectInput according to previous forms answers

Question

I'm new user of RShiny and I need your precious help.Excuse my english, I hope you will understand my issue.

My goal: create a booking tool (form to book pizza at summer events). The user will therefore fill out a form indicating their personal information (name, phone numer, mail, ...), the reservation date (selectInput), the number of pizzas they wish to reserve (sliderInput from 1 to 6) as well as the time slot to pick up their pizza(s) (selectInput). Time slots are in quarter-hour intervals. There is other information but there is no need to specify it here.

My issue : in practice, we can only cook 7 pizzas per quarter of an hour. I want that only available time slot appear in the selectInput of time slot. What is an available time slot --> Time slot with less than 7 pizzas booked, on the day the user chose. The application must therefore retrieve all previous responses, aggregate by date and by time slot the number of pizzas already booked PLUS the number of pizzas that the current user is booking. And only show available time slots.

For example : a user is connected and want to book 3 pizzas on the Friday 26th of July. The app will checks on the Friday 26th of July : how many pizza are already booked per time slot, add the 3 pizzas and show only the time slot where nb pizza already booked + 3 < 7.

I hope I'm clear enough.

Here is my code : responses are saved in local file for now. 3 files : GLOBAL / UI / SERVER

GLOBAL

setwd("D:/Documents/XXX/application")

#Champs obligatoires ? remplir
fieldsMandatory <- c("name", "mail", "number", "date", "hour", "nb_pizzas")

#Ajouter un ast?rique aux champs obligatoires
labelMandatory <- function(label) {
  tagList(
    label,
    span("*", class = "mandatory_star")
  )
}

#couleur rouge de l'?toile et du message d'erreur
appCSS <-
  ".mandatory_star { color: red; }
   #error { color: red; }"

#Enregistrement des r?ponses : quel input je veux garder
fieldsAll <- c("name", "mail", "number", "date","hour", "nb_pizzas", "type")
responsesDir <- file.path("D:", "Documents", "XXX", "responses", fsep="\\")
outputDir <- "responses"

# get a formatted string of the timestamp (exclude colons as they are invalid
# characters in Windows filenames)
humanTime <- function() {
  format(Sys.time(), "%Y%m%d-%H%M%OS")
}

##save data on local files
saveData <- function(data) {
  fileName <- sprintf("%s_%s.csv",
                      humanTime(),
                      digest::digest(data))

  write.csv(x = data, file = file.path(responsesDir, fileName),
            row.names = FALSE, quote = TRUE)
}


#Here's our function that will retrieve all submissions and load them into a data.frame. 
loadData <- function() {
 files <- list.files(file.path(responsesDir), full.names = TRUE)
 data <- lapply(files, read.csv, stringsAsFactors = FALSE)
 data <- do.call(rbind, data)
 data
}

UI

ui = fluidPage(
  
  
  shinyjs::useShinyjs(),
  shinyjs::inlineCSS(appCSS),
  titlePanel("Réservation CHEZ LUCETTE"),
  
  #add a dataTable placeholder to the UI 
  DT::dataTableOutput("responsesTable"),
  
  div(
    id = "form",
    
    textInput("name", labelMandatory("Name and surname"), ""),
    textInput("mail", labelMandatory("Mail")),
    textInput("number", labelMandatory("Phone Number")),
    selectInput("date", labelMandatory("When do you want book ?"),
                c("Vendredi 28 juin",
                  "Vendredi 5 juilllet",  
                  "Vendredi 12 juillet",  
                  "Vendredi 19 juillet",  
                  "Vendredi 26 juillet",  
                  "Vendredi 02 août",  
                  "Vendredi 09 août",  
                  "Vendredi 16 août",  
                  "Vendredi 23 août")),
    #checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
    sliderInput("nb_pizzas", "How many pizzas ?", 1, 6, 1, ticks = TRUE),
    selectInput("hour", labelMandatory("Choose a time slot for your pizzas"),
                c("18h30-18h45",
                  "18h45-19h00",  
                  "19h00-19h15",  
                  "19h15-19h30",  
                  "19h30-19h45",  
                  "19h45-20h00",  
                  "20h00-20h15",  
                  "20h15-20h30",  
                  "20h30-20h45", 
                  "20h45-21h")),
    selectInput("type", "Would you like eat at the farm, take away ?",
                c("At the farm",  "Take-away", "I don't know yet !")),
    actionButton("submit", "Submit my booking", class = "btn-primary"), 
    
    #we need to add a “Submitting…” progress message and an error message container to the UI 
    shinyjs::hidden(
      span(id = "submit_msg", "Submitting..."),
      div(id = "error",
          div(br(), tags$b("Error: "), span(id = "error_msg"))
      )
    )
    
  ), 
  
  #message de remerciement
  shinyjs::hidden(
    div(
      id = "thankyou_msg",
      #h3(paste("Merci, votre réservation pour le", input$date,", Merci !")),
      h3("Merci, votre réservation a bien été prise en compte !"),
      actionLink("submit_another", "Cliquez içi pour une nouvelle réservation")
    )
  )  
)

SERVER

server = function(input, output, session) {
  # Enable the Submit button when all mandatory fields are filled out
  observe({
    mandatoryFilled <-
      vapply(fieldsMandatory,
             function(x) {
               !is.null(input[[x]]) && input[[x]] != ""
             },
             logical(1))
    mandatoryFilled <- all(mandatoryFilled)
    
    shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
  })  
  
  # Gather all the form inputs 
  formData <- reactive({
    data <- sapply(fieldsAll, function(x) input[[x]])
    #data <- c(data)
    data <- t(data)
    data
  }) 
  
  # action to take when submit button is pressed
  #When the “submit” button is pressed, we want to: 
  #disable the button from being pressed again, show the “Submitting…” message, 
  #and hide any previous errors. We want to reverse these actions when saving the data is finished. 
  #If an error occurs while saving the data, we want to show the error message.
  observeEvent(input$submit, {
    shinyjs::disable("submit")
    shinyjs::show("submit_msg")
    shinyjs::hide("error")
    
    tryCatch({
      saveData(formData())
      shinyjs::reset("form")
      shinyjs::hide("form")
      shinyjs::show("thankyou_msg")
    },
    error = function(err) {
      shinyjs::html("error_msg", err$message)
      shinyjs::show(id = "error", anim = TRUE, animType = "fade")
    },
    finally = {
      shinyjs::enable("submit")
      shinyjs::hide("submit_msg")
    })
  })
  
  
  # action to take when submit_another button is pressed
  observeEvent(input$submit_another, {
    shinyjs::show("form")
    shinyjs::hide("thankyou_msg")
  })   
  
  
  #we just need to tell the dataTable in the UI to display that data.
  output$responsesTable <- DT::renderDataTable(
   loadData(),
   rownames = FALSE,
   options = list(searching = FALSE, lengthChange = FALSE)
  )
}

Till here, I've created the form and made appear the datatable of previous answers (it won't appear in the final version of course). Now, I don't know how process to create this filter.screenshot of the app

Answer 1

you're looking for updateSelectInput. See the documentation here

But in short, it is a way within the server of processing your data within an observer and passing it back to the UI.

e.g. in the server:

observe({
    <some input data or checks>

    <do some analysis to provide only the timeslots that are available>

    updateSelectInput(session, "inSelect",
      label = paste("Select input label", length(x)),
      choices = <your new inputs>
    )
  })