Thank you so much!!!
For convenience, I provide a simple case.
library(shiny)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("text_demo")
saveData <- function(input) {
# put variables in a data frame
data <- data.frame(matrix(nrow=1,ncol=0))
for (x in fields) {
var <- input[[x]]
if (length(var) > 1 ) {
# handles lists from checkboxGroup and multiple Select
data[[x]] <- list(var)
} else {
# all other data types
data[[x]] <- var
}
}
data$submit_time <- date()
# Create a unique file name
fileName <- sprintf(
"%s_%s.rds",
as.integer(Sys.time()),
digest::digest(data)
)
# Write the file to the local system
saveRDS(
object = data,
file = file.path(outputDir, fileName)
)
}
loadData <- function() {
# read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
if (length(files) == 0) {
# create empty data frame with correct columns
field_list <- c(fields, "submit_time")
data <- data.frame(matrix(ncol = length(field_list), nrow = 0))
names(data) <- field_list
} else {
data <- lapply(files, function(x) readRDS(x))
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
}
data
}
# Define questions
text_demo <- textInput("text_demo", "What is your favourite color?")
resetForm <- function(session) {
updateTextInput(session, "text_demo", value = "")
}
# Set up questionnaire interface ----
ui <- fluidPage(
title = "Questionnaire Framework",
h3("My Survey"),
p("Please fill out the following brief survey..."),
fluidRow(
column(width=6, text_demo)
),
actionButton("submit", "Submit")
)
# Reactive functions ----
server = function(input, output, session) {
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(input)
resetForm(session)
# thank the user
n_responses <- length(list.files(outputDir))
response <- paste0("Thank you for completing the survey! You are respondant ",
n_responses, ".")
showNotification(response, duration = 0, type = "message")
})
}
shinyApp(ui, server)