Using shiny for Surveys

When designing a survey in shiny, the widgets documentation will be your friend. These outline all of the possible UI inputs. Here, we use three:

New Issues that Arise

1). Saving final state reactive data to a local machine or server

2). Incorporating JavaScript (via shinyjs)

  • Mandatory questions
  • Hiding the submit button until items complete
  • Moving to another page when submitting success
  • Submitting another response
# This Shiny app was taken heavily from:
# http://deanattali.com/2015/06/14/mimicking-google-form-shiny/
# and altered by Daniel Albohn, 12/06/17  

# Define some stuff in the global scope

fieldsMandatory <- c("title")

labelMandatory <- function(label) {
  tagList(
    label,
    span("*", class = "mandatory_star")
  )
}

appCSS <-
  ".mandatory_star { color: red; }
#error { color: red; }"

fieldsAll <- c('title', 'age', 'area', 'rate_this')
responsesDir <- file.path("responses")

epochTime <- function() {
  as.integer(Sys.time())
}

humanTime <- function() format(Sys.time(), "%Y%m%d-%H%M%OS")

# The actual Shiny app

shinyApp(
  
  ## UI portion
  ui = fluidPage(
    
    shinyjs::useShinyjs(), ## This is important if you use JavaScript in your app!
    shinyjs::inlineCSS(appCSS),
    
    titlePanel("A Simple shiny Survey"),
    h4("Built using R and Shiny!"),
    
    ## The actual questions
    div(id = "form", # Display the questions
        
        textInput("title", labelMandatory("What is your title?"), "",
                  placeholder = "e.g., Grad, Faculty, etc."),
        
        numericInput("age", label = "What is your age?",
                     value = 0, min = 16, max = 100),
        
        textInput("area", label = "Program area" , "",
                  placeholder = "e.g., Clinical, Developmental, etc."),
        
        # Slider ratings for individual sessions
        sliderInput("rate_this", "How would you rate this tutorial?",
                    min = 1, max = 7, value = 0, ticks = TRUE),
        
        # Submit this and save
        actionButton("submit", "Submit", class = "btn-primary"),
        
        # Submit button and error handling
        shinyjs::hidden(
          span(id = "submit_msg", "Submitting..."),
          div(id = "error",
              div(br(), tags$b("Error: "), span(id = "error_msg"))
          )
        )
    ),
    
    shinyjs::hidden(
      div(
        id = "thankyou_msg",
        h3("Thanks, your response was submitted successfully!"),
        actionLink("submit_another", "Submit another response")
      )
    ) 
  ),
  
  ## Server portion
  server = function(input, output, session) {
    
    ## The sever is wrapped in one giant observer
    observe({
      
      ## Make sure that the mandatory fields defined earlier are filled
      mandatoryFilled <-
        vapply(fieldsMandatory,
               function(x) {
                 !is.null(input[[x]]) && input[[x]] != ""
               },
               logical(1))
      
      ## All TRUE
      mandatoryFilled <- all(mandatoryFilled)
      
      shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
      
      ## Create a reactive data frame from the form responses
      formData <- reactive({
        data <- sapply(fieldsAll, function(x) input[[x]])
        data <- c(data, timestamp = epochTime())
        data <- t(data)
        data
      })
      
      ## Save the data frame
      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)
      }
      
      ## Action to take when submit button is pressed
      observeEvent(input$submit, {
        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 button is pressed
      observeEvent(input$submit, {
        saveData(formData())
        shinyjs::reset("form")
        shinyjs::hide("form")
        shinyjs::show("thankyou_msg")
      })
      
      ## What to do if the user wants to submit another response
      observeEvent(input$submit_another, {
        shinyjs::show("form")
        shinyjs::hide("thankyou_msg")
      })
    })
    
  }
)

Be sure to check out the resource page for more advanced tutorials (including shinyjs) and how to extend shiny.

Creative Commons License