R Shiny Mandatory Fields Survey Form

Question

I created a simple survey form in R Shiny (see code underneath). Now I would like to add some functionality that requires input on all questions on a specific page, before the 'Next' button works. So, if you press 'next' on the first page, but have not answered the first three questions, an alert/error message must appear. The same goes for the second, third, fourth page etc. This example has a few questions, but my final questionnaire would have around 15-20 questions.

It would be great if someone could help me out!

library(shiny)
library(shinyjs)

NUM_PAGES = 3

categories_1 <- c('a', 'b', 'c', 'd') 
categories_2 <- c('e', 'f', 'g', 'h')


ui <- fluidPage(
  useShinyjs(),
  hidden(
    div(
      class = "page",
      id = "page1",
      uiOutput("ui1"),
      uiOutput("ui2"),
      uiOutput("ui3")
    ),
    div(
      class = "page",
      id = "page2",
      uiOutput("ui4")
    ),
    div(
      class = "page",
      id = "page3",
      actionButton("submit", "Submit")
    )
  ),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
)

server <- function(input, output, session) {
  rv <- reactiveValues(page = 1)
  
  output$ui1 <- renderUI({
    selectizeInput("select1", label = h5("Question #1"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui2 <- renderUI({
    selectizeInput("select2", label = h5("Question #2"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3", label = h5("Question #3"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4", label = h5("Question #4"),
                   choices = sort(categories_2),
                   multiple = TRUE,
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  observe({
    toggleState(id = "prevBtn", condition = rv$page > 1)
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES)
    hide(selector = ".page")
    show(
      paste0("page", rv$page)
    )
    
  })
  
  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }
  
  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, navPage(1))
  
  # Automatically stop a Shiny app when closing the browser tab
  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

One way would be to do it manually like `if(rv$page==1 & any(input$select1,input$select2,..)=="")){display error code} else { navPage(1)}` something like that added to your observeEvent for the nextBtn — , Jun 03 '21 at 16:19
Hi, I had to change the code a bit, but I made it work. Thank you! I changed the code into: `observeEvent(input$nextBtn, if(rv$page==1 & "" %in% list(input$select1, input$select2, input$select3)){ feedbackDanger("select1", input$select1 == "", "Please make decision") feedbackDanger("select2", input$select2 == "", "Please make decision") feedbackDanger("select3", input$select3 == "", "Please make decision")} else {navPage(1)})` — Jerome, Jun 03 '21 at 19:39
If you have solved this question yourself you can add it as an answer below. You are encouraged to answer your own question. — Ronak Shah, Jun 04 '21 at 01:29

score 4 · Accepted Answer · answered Jun 05 '21 at 23:03

Final result with working code:

library(shiny)
library(shinyjs)
library(shinyFeedback)

NUM_PAGES = 3

categories_1 <- c('a', 'b', 'c', 'd') 
categories_2 <- c('e', 'f', 'g', 'h')


ui <- fluidPage(
  useShinyjs(),
  shinyFeedback::useShinyFeedback(),
  hidden(
    div(
      class = "page",
      id = "page1",
      uiOutput("ui1"),
      uiOutput("ui2"),
      uiOutput("ui3")
    ),
    div(
      class = "page",
      id = "page2",
      uiOutput("ui4")
    ),
    div(
      class = "page",
      id = "page3",
      actionButton("submit", "Submit")
    )
  ),
  br(),
  actionButton("prevBtn", "< Previous"),
  actionButton("nextBtn", "Next >")
)

server <- function(input, output, session) {
  rv <- reactiveValues(page = 1)
  
  output$ui1 <- renderUI({
    selectizeInput("select1", label = h5("Question #1"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui2 <- renderUI({
    selectizeInput("select2", label = h5("Question #2"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui3 <- renderUI({
    selectizeInput("select3", label = h5("Question #3"),
                   choices = sort(categories_1),
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  output$ui4 <- renderUI({
    selectizeInput("select4", label = h5("Question #4"),
                   choices = sort(categories_2),
                   multiple = TRUE,
                   options = list(placeholder = 'Choose answer',
                                  onInitialize = I('function() { this.setValue(""); }')))
  })
  
  observe({
    toggleState(id = "prevBtn", condition = rv$page > 1)
    toggleState(id = "nextBtn", condition = rv$page < NUM_PAGES)
    hide(selector = ".page")
    show(
      paste0("page", rv$page)
    )
    
  })
  
  navPage <- function(direction) {
    rv$page <- rv$page + direction
  }
  
  observeEvent(input$prevBtn, navPage(-1))
  observeEvent(input$nextBtn, 
               if(rv$page==1 & "" %in% list(input$select1, input$select2, input$select3)){
                 feedbackDanger("select1", input$select1 == "", "Please make decision")
                 feedbackDanger("select2", input$select2 == "", "Please make decision")
                 feedbackDanger("select3", input$select3 == "", "Please make decision")
               } else {navPage(1)})
  
  # Automatically stop a Shiny app when closing the browser tab
  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

R Shiny Mandatory Fields Survey Form

1 Answers1