I created a toy example to show the basic workflow I'm trying to create in a shiny flexdashboard.
Run this piece first, separate from the dashboard. It creates the initial long dataset that we will add to with each submission.
df <- data.frame(id = c(1, 1, 1, 1, 2, 2, 2, 3, 3, 4, 5, 6, 7),
question = c("Do you like red",
"Do you like red",
"Do you like red",
"Do you like red",
"Do you like orange",
"Do you like orange",
"Do you like orange",
"Do you like yellow",
"Do you like yellow",
"Do you like green",
"Do you like blue",
"Do you like indigo",
"Do you like violet"),
rater = c(1, 2, 3, NA, 1, 2, NA, 1, NA, NA, NA, NA, NA),
answer = c("yes", "no", "yes", NA,
"yes", "no", NA,
"yes", NA,
NA,
NA,
NA,
NA)
)
write.csv(df, file="df.csv", row.names = FALSE)
Here we have 7 questions with some answers by a few raters.
# id question rater answer
#1 1 Do you like red 1 yes
#2 1 Do you like red 2 no
#3 1 Do you like red 3 yes
#4 1 Do you like red NA <NA>
#5 2 Do you like orange 1 yes
#6 2 Do you like orange 2 no
#7 2 Do you like orange NA <NA>
#8 3 Do you like yellow 1 yes
#9 3 Do you like yellow NA <NA>
#10 4 Do you like green NA <NA>
#11 5 Do you like blue NA <NA>
#12 6 Do you like indigo NA <NA>
#13 7 Do you like violet NA <NA>
Here's what I'm trying to accomplish in the app:
raterID==1
in this example) has not answered.selectInput()
.df
df
I am ok through step 4. The next question appears in the UI, but the data do not save.
Flexdashboard:
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
# load packages
library(flexdashboard)
library(tidyverse)
library(shiny)
set.seed(1)
# run separate script to generate df and save to csv
# load data
df <- read.csv("df.csv", stringsAsFactors = FALSE)
# assign a fixed rater ID for this example
raterID <- 1
# initial processing ----------------------------------------------------------
# identify which questions in df rater already answered
done <-
df %>%
filter(rater==raterID)
# remove these questions and pick one of the remaining to present to the rater
toAnswer <-
df %>%
filter(!(id %in% done$id)) %>%
sample_n(1)
```
Column
-----------------------------------------------------------------------
```{r}
# create an object for the selected question
output$textq <- renderText(as.character(toAnswer$question))
# ui with the question and a selectInput
mainPanel(
textOutput("textq"),
br(),
br(),
selectInput("answer", "Select:",
choices = c("yes", "no")),
actionButton("submit", "Submit", width = '200px')
)
# create dataframe with 1 row containing selected question, rater, and answer
dat <- reactive({
req(input$answer)
data.frame(id = toAnswer$id,
question = toAnswer$question,
rater = raterID,
answer = input$answer
)
})
# submit data
observeEvent(input$submit, {
# add new row to df
df <-
df %>%
bind_rows(dat())
write.csv(df, file="df.csv", row.names = FALSE)
# start over with initial processing
# identify which questions in df rater already answered
done <-
df %>%
filter(rater==raterID)
# remove these questions and pick one of the remaining to present to the rater
toAnswer <-
df %>%
filter(!(id %in% done$id)) %>%
sample_n(1)
# present new question
output$textq <- renderText(as.character(toAnswer$question))
# reset input
updateSelectInput(session, "answer", "Select:",
choices = c("yes", "no"))
})
```