我创建了一个玩具示例，以展示我试图在闪亮的Flexdashboard中创建的基本工作流程。
首先运行此部分，与仪表板分开。它将创建初始的长数据集，我们将在每次提交时将其添加到其中。
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>
这就是我要在应用程序中完成的工作：
raterID==1）尚未回答。selectInput()收集答案。df中添加一行数据df 我可以通过第4步。下一个问题出现在UI中，但是数据没有保存。
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"))
})
```