首页 > 解决方案 > shinyAPP:更改反应数据集的值

问题描述

我想为我的女儿编写一个闪亮的应用程序来学习词汇。

数据集是一个 data.frame,有四列:Unit、Part、German、Engilsh

我女儿应该先选择单元,然后选择部分。这可以正常工作并提供交互式数据框。我称它为seldf,在响应式代码中它是seldf()

之后,shinyapp 从这个交互式数据框中随机选择一行并询问:德语表达的英语单词是什么?

这应该inputText由我女儿在一个字段中输入。然后她必须点击Proove按钮来prove判断她的输入是否正确。这也很好用!

要继续学习,还有另一个操作按钮 -下一个单词- 以获得下一个随机选择的德语表达。

这是我的问题:

如果我女儿是对的,那么应该从seldf(). 很可能我想通过过滤“删除”该行。这意味着我想在数据框中添加一个标志。这是过滤表达式需要seldf()正确过滤新的 如果我女儿错了,seldf()保持不变。

我怎样才能在我的代码中做到这一点?

你会在这里找到我的代码:

https://github.com/StatistikVolker/Vokabeln

保持健康!

沃尔克

标签: rshiny-servershinyappsshiny-reactivity

解决方案


与其每次您的女儿单击“下一步”按钮时随机选择一个新词,我认为seldf在应用程序加载时将(非反应性)数据帧排序为随机顺序会稍微容易一些。Proove 按钮的observeEvent处理程序检查她是否回答正确,显示适当的消息,并在适当的情况下更新非反应性seldfseldf()每次单击下一步时,反应式都会简单地返回过滤(非反应式)数据帧的第一行。

像这样(未经测试)的代码:

# Sort the input dataframe into random order (and add an "answered" flag)
inputDF <- inputDF %>% 
             mutate(
               Random=runif(nrow(.), 
               CorrectlyAnswered=FALSE
             ) %>% 
             arrange(Random)

# Provide the current question and answer
seldf <- reactive ({
  # Ensure response after a correct answer
  input$proove
  inputDF %>% filter(!AnsweredCorrectly) %>% head(1)
})

# Handle Proove button clicks
observeEvent(input$proove, {
  req(seldf(), input$answerText)

  if (seldf()$English[1] == input$answerText) {
    inputDF <- inputDF %>% 
                 mutate(
                   CorrectlyAnswered=ifelse(
                                       English == input$answerText, 
                                       TRUE, 
                                       CorrectlyAnswered
                                     )
                   )
    # Display success message
  } else {
    # Display failure message
  }
})

更新

这是一个基于mtcars数据集的 MWE,展示了如何reactive使用 a 动态过滤静态基础数据帧。UI 使用两个selectInputs 创建一个reactive基于用户定义的mtcars数据集过滤。然后reactive用于显示绘图和数据列表。

library(shiny)

ui <- fluidPage(
  # Note the use of "- Show all -"="" to allow a "no filter" option
  selectInput(
    inputId="cylSelect", 
    label="Filter by number of cylinders", 
    choices=c("- Show all -"="", sort(unique(mtcars$cyl))),
    multiple=TRUE
  ),
  selectInput(
    inputId="carbSelect", 
    label="Filter by number of carburetor barrels", 
    choices=c("- Show all -"="", sort(unique(mtcars$carb))),
    multiple=TRUE
  ),
  plotOutput("plot"),
  tableOutput("table")
)

server <- function(input, output, session) {
   filteredCars <- reactive({
      df <- mtcars %>% rownames_to_column("Model")
      if (!is.null(input$cylSelect)) {
        df <- df %>% filter(cyl %in% input$cylSelect)
      }
      if (!is.null(input$carbSelect)) {
        df <- df %>% filter(cyl %in% input$carbSelect)
      }
      df
   })
   
   output$plot <- renderPlot({
     filteredCars() %>% 
       ggplot() + 
         geom_point(aes(x=mpg, y=disp, colour=as.factor(gear)))
   })
   
   output$table <- renderTable({ filteredCars() })
}

shinyApp(ui = ui, server = server)

如果您需要触发对reactive按钮单击的更新,只需reactive像我在原始帖子中所做的那样引用按钮。这足以触发更新。


推荐阅读