根据闪亮的输入向数据框添加一行,保存结果,然后重新开始
adding a row to a dataframe based on shiny inputs, saving the result, and starting over again
我创建了一个玩具示例来展示我试图在闪亮的 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
- 重新开始提出下一个评分者 1 尚未回答的问题。
- 将数据行添加到
df
- 重复
我通过第4步没问题。下一个问题出现在UI,但数据没有保存。
Flex 仪表板:
---
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"))
})
```
我创建了一个玩具示例来展示我试图在闪亮的 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
- 重新开始提出下一个评分者 1 尚未回答的问题。
- 将数据行添加到
df
- 重复
我通过第4步没问题。下一个问题出现在UI,但数据没有保存。
Flex 仪表板:
---
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"))
})
```