добавление строки в кадр данных на основе блестящих входных данных, сохранение результата и повторный запуск

Question

Я создал игрушечный пример, чтобы показать базовый рабочий процесс, который я пытаюсь создать, на блестящей флексбашне.

Сначала запустите этот фрагмент, отдельно от панели инструментов.Он создает начальный длинный набор данных, который мы будем добавлять при каждой отправке.

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)

Здесь у нас есть 7 вопросов с несколькими ответами от нескольких оценщиков.

#   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>

Вот что я 'm пытается выполнить в приложении:

1. Загрузить данные
2. Представить вопросы, на которые оценщик (жестко закодированный как raterID==1 в этом примере) не ответил.
3. Соберите ответ с помощью selectInput().
4. Добавьте строку данных к оригиналу df
5. Начните сначала, представив следующий вопрос. Оценщик 1 не ответил.
6. Добавьте строку данных в df
7. Повтор

Я в порядке, выполнив шаг 4. Следующий вопрос появляется в пользовательском интерфейсе, но данные не сохраняются.

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

  })
```

Answer 1

Одним из решений является использование eventReactive().Я писал об этом подходе здесь , репо с кодом здесь .