Search code examples
rshinyflexdashboard

adding a row to a dataframe based on shiny inputs, saving the result, and starting over again


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:

  1. Load the data
  2. Present questions the rater (hard coded to raterID==1 in this example) has not answered.
  3. Collect the answer via selectInput().
  4. Add a row of data to the original df
  5. Start over by presenting the next question rater 1 has not answered.
  6. Add the row of data to df
  7. Repeat

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"))

  })
```

Solution

  • One solution is to use eventReactive(). I wrote about this approach here, repo with code here.