更改反应式数据集的值[已关闭]

问题描述 投票：0回答：3

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

数据集是一个包含四列的 data.frame：Unit、Part、German、Engilsh

我女儿应该首先选择单元，然后选择零件。这工作得很好，并提供了一个交互式数据框。我称之为 

seldf
，在反应式代码中它是 
seldf()
。

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

这应该由我女儿在 

inputText
字段中输入。然后，如果她的输入正确，她必须单击 Proove 按钮来 
prove
。这也很好用！

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

这是我的问题：

如果我女儿是对的，则应该从

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

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

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

https://github.com/StatistikVolker/Vokabeln

r shiny shiny-reactivity
3个回答
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 使用两个 
selectInput
根据用户定义的 
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
中的按钮，就像我在原始帖子中所做的那样。 这足以触发更新。

0
投票

这是我根据 @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)
0
投票

OP上面的回答有很多问题。

首先，

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

其次，操作按钮的id是

save
，而不是
Save
。 
Dave
是它的标签。 所以事件观察者无论如何都不会被触发。 当您期望触发事件观察者（或其他反应性）时，确认事件观察者（或其他反应性）是否被触发的一个好技术是简单地将 
print
语句放入反应性中。

为了获得OP所需的功能，我们需要颠倒我最初建议的逻辑。 当单击 save 按钮时，我们需要保留当前未选择的行。 这表明将按钮的名称 (id) 更改为 

analyse
（“分析”）是有意义的。
其次，为了确保仅在单击保存按钮时更新非反应式筛选数据集（而不是在更新 
selectCyl
 选择输入中的选择时更新），我们需要 
isolate
 对 
input$selectCyl
 的引用。 
最后，为了克服上述范围问题，我们需要在事件观察器中使用全局赋值运算符 
<<-
（或者更一般地说，
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)


    
	

    

    


  

  

    
最新问题


  





  

    © www.soinside.com 2019 - 2024. All rights reserved.