Using R Shiny to create web surveys, display instant feedback, and store data on Google Drive
When I decided to make an online survey myself (rather than using Qualtrics like I usually do) I found some good tutorials on posting survey questions but had a hard time finding a tutorial for saving the survey responses. The tutorial below shows how to make a web survey using the Ten Item Personality Inventory (a brief measure of the Big 5 Personality Inventory) that displays participant’s responses, an explanation of the personality types, and their score on a normal distribution. I hope this is useful to anyone wanting to collect online data.
https://jwyckoff.shinyapps.io/TIPIpersonality/
The first step is to get your google drive shiny token to enable access to your google drive. You will have to enter your Gmail address and password. Next, you will set up a new spreadsheet and create the headers. For a while, I was having trouble storing the data in Google Drive, my friend pointed out that he had similar problems if the first few rows of the spreadsheet are blank. I am not sure why, but after adding in some numbers directly into the first few rows of the spreadsheet it started working.
#load libraries
library(shiny)
library(shinydashboard)
library("googlesheets")
library("DT")#get your token to access google drive
shiny_token <- gs_auth()
saveRDS(shiny_token, "shiny_app_token.rds")
After you save your token, you should see a token icon in your app folder
#set up data sheet in google drive
Data <- gs_new("Data") %>%
gs_ws_rename(from = "Sheet1", to = "Data")
Data <- Data %>%
gs_edit_cells(ws = "Data", input = cbind("open1", "open2", "consc1", "consc2", "extra1", "extra2", "agree1", "agree2", "neur1", "neur2", "timestamp"), trim = TRUE)#Note: for some reason it wont work if first row is blank so I went into the google sheet and put in some values in the first few rowssheetkey <- "XXXX" # you can get your key from Data$sheet_key, don't share your sheet key!
Data <- gs_key(sheetkey)
You will find your spreadsheet in your Google Drive folder. I added in a few rows of all 5’s to get started since I was having troubles getting it to work when there were only blank rows. It is also a good idea to add a column for a timestamp (we will add Sys.time() to the spreadsheet in the server code).
For my survey, I wanted respondents to see where their scores fell on a distribution. To do this I simulated a normal distribution. If you want a more meaningful distribution, you could use data collected from your survey for the distribution (say if you were giving the survey to everyone at work, people could see where they fell relative to their colleagues).
#make a normal distribution to graph
set.seed(3000)
xseq<-seq(1,7,.01)
densities <-dnorm(xseq, 4,1)Shiny Apps are composed of two main parts, the user interface (UI) function, and the server function. See this tutorial for more information https://shiny.rstudio.com/articles/basics.html
The User Interface
First, we are just making a title and laying out our side panel. Next, we create slider inputs for all of the survey questions. Lastly, I am specifying the outputs people will see after the press submit (table of their scores, and a histogram and description of each personality trait).
# Define UI for application that draws a histogram
ui <- fluidPage(
# Define UI for slider demo app ----
ui <- fluidPage(
table <- "responses",
# App title ----
titlePanel("Personality Traits"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(
# Input: Extraversion 1 ----
sliderInput("extra1", "I see myself as someone who is extraverted, enthusiastic.",
min = 1, max = 7,
value = 1),
# Input: Agreeableness ----
sliderInput("agree1", "I see myself as someone who is critical, quarrelsome.",
min = 1, max = 7,
value = 1),
# Input: Conscientiousness 1 ----
sliderInput("consc1", "I see myself as someone who is dependable, self-disciplined.",
min = 1, max = 7,
value = 1),
# Input: Neuroticism 1 ----
sliderInput("neur1", "I see myself as someone who is anxious, easily upset.",
min = 1, max = 7,
value = 1),
# Input: Openess 1 ----
sliderInput("open1", "I see myself as someone who is open to new experiences, complex.",
min = 1, max = 7,
value = 1),
# Input: Extraversion 2 ----
sliderInput("extra2", "I see myself as someone who is reserved, quiet.",
min = 1, max = 7,
value = 1),
# Input: Agreeable 2 ----
sliderInput("agree2", "I see myself as someone who is sympathetic, warm.",
min = 1, max = 7,
value = 1),
# Input: Conscientiousness 2 ----
sliderInput("consc2", "I see myself as someone who is disorganized, careless",
min = 1, max = 7,
value = 1),
# Input: Neuroticissm 2 ----
sliderInput("neur2", "I see myself as someone who is calm, emotionally stable.",
min = 1, max = 7,
value = 1),
# Input: Openess 2 ----
sliderInput("open2", "I see myself as someone who is conventional, uncreative.",
min = 1, max = 7,
value = 1),
actionButton("submit", "Submit")
),The above code creates slider inputs for the survey questions. Shiny has other input options you may consider if you do not like the sliders. I like the slider for Likert scales but if you have just a few choices radio buttons or select inputs are a better option. See https://shiny.rstudio.com/images/shiny-cheatsheet.pdf for a summary of the different input functions.
# Main panel for displaying outputs ----
mainPanel(
# Output: Table summarizing the values entered ----
tableOutput("values"),
plotOutput("pe"),
textOutput("he"),
textOutput("le"),
plotOutput("pc"),
textOutput("hc"),
textOutput("lc"),
plotOutput("po"),
textOutput("ho"),
textOutput("lo"),
plotOutput("pa"),
textOutput("ha"),
textOutput("la"),
plotOutput("pn"),
textOutput("hn"),
textOutput("ln")
))
)
)We will go over how to input the values in the server section, but the table output will end up looking like this:
The text and plot outputs are below the table. Right now we are just specifying to shiny where we want the tables and text to be.
The Server
I used the reactive() function to display data only after they press submit.
server <- function(input, output, session) {
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("Openness",
"Conscientiousness",
"Extraversion",
"Agreeableness",
"Neuroticism"),
Value = as.character(c((input$open1 + (8-input$open2))/2,
(input$consc1 + (8 - input$consc2))/2,
(input$extra1 + (8 - input$extra2))/2,
(input$agree2 + (8 - input$agree1))/2,
(input$neur1 + (8 - input$neur2))/2)),
stringsAsFactors = FALSE)
})
Below I plot the normal distribution we simulated earlier and use abline() to add a line for where their score falls and a description of the personality measure. A tidier way would be to put the text descriptions in a spreadsheet but for this example, we only have 5 personality traits so I just included the descriptions in the code below.
# Show the values in an HTML table, only after they press submit
observeEvent(input$submit, {
output$values <- renderTable({
sliderValues()
})
output$pe <- renderPlot({
plot(xseq, densities, type = "l", lwd = 2, main = "Extraversion: \n How does your score compare to others?", xlab = "Scores", yaxt='n', ylab = "")
abline(v=((input$extra1 + (8 - input$extra2))/2), col="blue")
text(((input$extra1 + (8 - input$extra2))/2), 0.1, "Your Score", col = "red")
})output$he <- renderText({
'High: Extraverts get their energy from interacting with others, while introverts get their energy from within themselves. Extraversion includes the traits of energetic, talkative, and assertive. They enjoy being with people, participating in social gatherings, and are full of energy.'
})
output$le <- renderText({
'Low: A person low in extraversion is less outgoing and is more comfortable working by himself.'
})output$pc <- renderPlot({
plot(xseq, densities, type = "l", lwd = 2, main = "Conscientiousness: \n How does your score compare to others?", xlab = "Scores", yaxt='n', ylab = "")
abline(v=((input$consc1 + (8 - input$consc1))/2), col="blue")
text(((input$consc1 + (8 - input$consc1))/2), 0.1, "Your Score", col = "red")
})output$hc <- renderText({
'High: People that have a high degree of conscientiousness are reliable and prompt. Traits include being organized, methodic, and thorough. A person scoring high in conscientiousness usually has a high level of self-discipline. These individuals prefer to follow a plan, rather than act spontaneously. Their methodic planning and perseverance usually makes them highly successful in their chosen occupation.'
})output$lc <- renderText({
'Low: People who score low on conscientiousness tend to be laid back, less goal-oriented, and less driven by success.'
})output$po <- renderPlot({
plot(xseq, densities, type = "l", lwd = 2, main = "Openness to Experience: \n How does your score compare to others?", xlab = "Scores", yaxt='n', ylab = "")
abline(v=((input$open1 + (8-input$open2))/2), col="blue")
text(((input$open1 + (8-input$open2))/2), 0.1, "Your Score", col = "red")
})output$ho <- renderText({
'High: People who like to learn new things and enjoy new experiences usually score high in openness. Openness includes traits like being insightful and imaginative and having a wide variety of interests.'
})
output$lo <- renderText({
'Low: People who score low on openness tend to be conventional and traditional in their outlook and behavior. They prefer familiar routines to new experiences, and generally have a narrower range of interests.'
})output$pa <- renderPlot({
plot(xseq, densities, type = "l", lwd = 2, main = "Agreeableness: \n How does your score compare to others?", xlab = "Scores", yaxt='n', ylab = "")
abline(v=((input$agree2 + (8 - input$agree1))/2), col="blue")
text(((input$agree2 + (8 - input$agree1))/2), 0.1, "Your Score", col = "red")
})output$ha <- renderText({
'High: A person with a high level of agreeableness in a personality test is usually warm, friendly, and tactful. They generally have an optimistic view of human nature and get along well with others.'
})
output$la <- renderText({
'Low: People with low agreeableness may be more distant and may put their own interests above those of others. They tend to be less cooperative. '
})output$pn <- renderPlot({
plot(xseq, densities, type = "l", lwd = 2, main = "Neuroticism: \n How does your score compare to others?", xlab = "Scores", yaxt='n', ylab = "")
abline(v=((input$neur1 + (8 - input$neur2))/2), col="blue")
text(( (input$neur1 + (8 - input$neur2))/2), 0.1, "Your Score", col = "red")
})output$hn <- renderText({
'High: This dimension relates to one’s emotional stability and degree of negative emotions. People that score high on neuroticism often experience emotional instability and negative emotions. Traits include being moody and tense. A person who is high in neuroticism has a tendency to easily experience negative emotions.'
})output$ln <- renderText({
"Low: On the other end of the section, people who score low in neuroticism experience more emotional stability. Emotional stability refers to a person's ability to remain stable and balanced. They tend to experience negative emotions less easily and handle stress well."
})
})
After they press submit, they will see where they fall on a normal distribution curve.
Lastly, we need to tell the server to save the inputs after the user presses submit using reactive(). We then use observeEvent() to add the results to our Google Sheet when the user presses submit.
#store the results
Results <- reactive(c(
input$open1, input$open2, input$consc1, input$consc2, input$extra1, input$extra2, input$agree1, input$agree2, input$neur1, input$neur2, Sys.time()
))
#This will add the new row at the bottom of the dataset in Google Sheets.observeEvent(input$submit, {
Data <- Data %>%
gs_add_row(ws = "Data", input = Results())
}
)
}shinyApp(ui = ui, server = server)
If you want to conduct multiple surveys on the same website, you might consider taking advantage of Shiny’s dashboards. Check out my friend Conal’s code that uses dashboards.