【问题标题】:adding a row to a dataframe based on shiny inputs, saving the result, and starting over again根据闪亮的输入向数据框添加一行,保存结果,然后重新开始
【发布时间】:2018-09-20 13:35:50
【问题描述】:

我创建了一个玩具示例来展示我尝试在闪亮的 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>

这是我想要在应用程序中完成的任务:

  1. 加载数据
  2. 当前评分者未回答的问题(在本例中硬编码为 raterID==1)。
  3. 通过selectInput()收集答案。
  4. 在原来的df中添加一行数据
  5. 通过提出下一个评估者 1 未回答的问题重新开始。
  6. 将该行数据添加到df
  7. 重复

我通过第 4 步没问题。下一个问题出现在 UI 中,但数据没有保存。

弹性仪表板:

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

  })
```

【问题讨论】:

    标签: r shiny flexdashboard


    【解决方案1】:

    一种解决方案是使用eventReactive()。我写了这个方法here,回购代码here

    【讨论】:

      猜你喜欢
      • 2022-01-07
      • 2020-06-23
      • 1970-01-01
      • 1970-01-01
      • 2017-03-07
      • 2018-01-03
      • 1970-01-01
      • 1970-01-01
      • 2021-09-16
      相关资源
      最近更新 更多