shinyAPP：更改反应数据集的值 [关闭]

Question

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

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

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

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

这应该由我女儿在inputText 字段中输入。然后，如果她的输入正确，她必须点击 Proove 按钮到prove。这也很好用！

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

这是我的问题：

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

如何在我的代码中执行此操作？

你可以在这里找到我的代码：

https://github.com/StatistikVolker/Vokabeln

保持健康！

沃尔克

Answer 1

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

类似这样的（未经测试的）代码：

# 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 动态过滤静态基础数据帧。 UI 使用两个selectInputs 根据用户定义的mtcars 数据集过滤创建reactive。然后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 中的按钮，就像我在原始帖子中所做的那样。这足以触发更新。

Answer 2

根据@Limey 对 1 答案的更新，这是我将数据保存回原始数据框的无效尝试。 问题是， output$table 没有更新，在第二次运行中，mtcars 的所有数据行仍然在我的分析中。 如何将变量添加到mtcars 以进行过滤以进行进一步分析？

library(shiny)
library(tidyverse)

ui <- fluidPage(
  # Note the use of "- Show all -"="" to allow a "no filter" option
  # Select mtcars by cylinders
  selectInput(
    inputId="cylSelect", 
    label="Filter by number of cylinders", 
    choices=c("- Show all -"="", sort(unique(mtcars$cyl))),
    multiple=TRUE
  ),
  # Action Button to Save analysed Data
  actionButton("save","Save"),
  # show datatable
  tableOutput("table"),
  tableOutput("filtab")
)

server <- function(input, output, session) {
  
  #Define extra variable into the mtcars dataset.
  inputDF <- mtcars %>% 
    rownames_to_column("Model") %>%
    mutate(analysed=FALSE)
  
  # Filter out cars by cylinder
  filteredCars <- reactive({
    df <- inputDF  %>% filter(analysed == FALSE)
    if (!is.null(input$cylSelect)) {
      df <- df %>% 
        filter(cyl %in% input$cylSelect)
    }
    df
  })

  
  # Save "analysed" cars based on reactive choosen cylinders back to dataset mt cars for next step in Analysis.
  # -- don't work! --
  observeEvent(input$Save,{
    if (!is.null(input$cylSelect)) {
      mtcars <- mtcars %>% 
        mutate(analysed = ifelse(cyl %in% input$cylSelect,TRUE,analysed)) 
    }
  })
  
  # Show updated mtcars
  # -- don't work! --
  output$table <- renderTable({ mtcars%>% rownames_to_column("Model") })

  # Show Filtered Table
  output$filtab <- renderTable({ filteredCars() })
}

shinyApp(ui = ui, server = server)

Answer 3

上面 OP 的回答存在许多问题。

首先，observeEvent(input$Save 中存在范围界定问题。事件观察者是函数。因此mtcars <- mtcars ... 创建了全局mtcars 对象的本地（修改后的）副本，然后在事件观察者终止时将其丢弃。 output$table <- renderTable 中引用的 mtcars 是未更改的全局对象。这种情况的一个症状是output$table 显示的表格不包含analysed 列。

其次，动作按钮的id是save，而不是Save。 Dave 是它的标签。所以事件观察者无论如何都不会被触发。确认事件观察者（或其他 ractive）在您期望触发时被触发的一种好方法是简单地将 print 语句放入响应中。

要获得 OP 所需的功能，我们需要颠倒我最初建议的逻辑。当单击save 按钮时，我们需要保留当前未 选择的行。这表明将按钮的名称（id）更改为analyse（“分析”）是有意义的。

其次，要确保非反应式过滤数据集仅在单击保存按钮时更新（而不是在selectCyl选择输入中的selction更新时，我们需要isolate引用@987654336 @。

最后，为了克服上述范围问题，我们需要在事件观察器中使用全局赋值运算符<<-（或更一般地，assign）。

在下面的代码中，analysedCars 仅在单击 Analyse 按钮时更新。 filteredCars 会在 selectCyl 中的选择更改后立即更新。

请注意，filteredCars 允许“未分析”行：也就是说，行将被添加回过滤后的数据集中，以响应selectCyl 选择输入的更改。 analysedCars 不会发生这种情况。这似乎是 OP 的意图。

在未分析行之前，filteredCars 和 analysedCars 的行为之间的唯一区别是更新的时间。

library(shiny)
library(tidyverse)

ui <- fluidPage(
  # Note the use of "- Show all -"="" to allow a "no filter" option
  # Select mtcars by cylinders
  selectInput(
    inputId="cylSelect", 
    label="Filter by number of cylinders", 
    choices=c("- Show all -"="", sort(unique(mtcars$cyl))),
    multiple=TRUE
  ),
  # Action Button to Save analysed Data
  actionButton("analyse","Analyse"),
  # show datatable
  tableOutput("table"),
  tableOutput("filtab")
)

server <- function(input, output, session) {
  #Define extra variable into the mtcars dataset.
  inputDF <- mtcars %>% 
    rownames_to_column("Model") %>%
    mutate(analysed=FALSE)
  # Take a copy for delayed updates
  analysedCars <- inputDF
  
  filteredCars <- reactive({
    df <- inputDF  %>% filter(analysed == FALSE)
    if (!is.null(input$cylSelect)) {
      df <- df %>% 
        filter(!(cyl %in% input$cylSelect))
    }
    df
  })
  
  observeEvent(input$analyse,{
    isolate({
      analysedCars <<- analysedCars %>% 
        mutate(analysed = cyl %in% input$cylSelect) %>% 
        filter(!analysed)
    })
    analysedCars
  })
  
  output$table <- renderTable({ 
    input$analyse
    analysedCars
  })
  
  output$filtab <- renderTable({ filteredCars() })
}

shinyApp(ui = ui, server = server)