单击按钮时更新小标题和下拉菜单；在下拉列表中做出选择时更新标题

Question

我在下面创建了 Shiny 应用程序：

library(shiny)
library(shinyWidgets)
library(tidyverse)

tbl1 <- tibble(obs = as_factor(letters[1:3]), val = -1:1)
tbl2 <- tibble(obs = as_factor(letters[1:3]), val = 0:2)

flag_outliers <- function(tbl) {
  tbl %>% mutate(is_outlier = near(val, min(val)) | near(val, max(val)))
}

ui <- fluidPage(
  column(6,
    radioButtons("tbl", "Select tibble", choices = c("tbl1", "tbl2")),
    actionButton("flag_w_func", "Flag outliers with function"),
    pickerInput(
      "user_choices", "Flag outliers yourself",
      letters[1:3], multiple = TRUE, options = pickerOptions(actionsBox = TRUE)
    )
  ),
  column(6, tableOutput("tbl_w_flags"))
)

server <- function(input, output, session) {
  tbl <- reactive(switch(input$tbl, tbl1 = tbl1, tbl2 = tbl2))
  
  tbl_w_flags <- reactive(flag_outliers(tbl())) # Not sure what this should be
  
  output$tbl_w_flags <- renderTable(tbl_w_flags())
}

shinyApp(ui, server)

这定义了两个tibbles，tbl1和tbl2，并允许用户选择一个；他们的选择存储在服务器函数的 tbl 中。我想在名为 tbl_w_flags 的服务器函数中创建另一个 tibble，即 tbl 加上一个 is_outlier 列。

如果用户单击“使用函数标记异常值”按钮，则应使用 flag_outliers() 设置 is_outlier 列。此外，下拉列表 user_choices 应在已被 flag_outliers() 标记的观察结果旁边显示复选标记，并且仅显示那些观察结果。

如果用户选中或取消选中下拉列表中的观察结果，则应适当更新 is_outlier 列 - 应将适当的值更改为 TRUE 或 FALSE。

因此，tbl_w_flags如果单击按钮或在下拉列表中进行选择，则需要修改tbl_w_flags，如果单击按钮，则需要修改下拉列表。

我没有太多闪亮的经验，正在努力弄清楚如何做到这一点。这可能吗？如果可以，如何实现？

Answer 1

我去掉了tbl_w_flags，直接更新了tbl()，这里不需要两个reactive。我还使用 reactiveVal 作为 reactive 并添加了 updatePickerInput 以在单击按钮时更新选择器

library(shiny)
library(shinyWidgets)
library(tidyverse)

tbl1 <- tibble(obs = as_factor(letters[1:3]), val = -1:1)
tbl2 <- tibble(obs = as_factor(letters[1:3]), val = 0:2)

flag_outliers <- function(tbl) {
  tbl %>% mutate(is_outlier = near(val, min(val)) | near(val, max(val)))
}

ui <- fluidPage(
  column(6,
         radioButtons("tbl", "Select tibble", choices = c("tbl1", "tbl2")),
         actionButton("flag_w_func", "Flag outliers with function"),
         pickerInput(
           "user_choices", "Flag outliers yourself",
           letters[1:3], multiple = TRUE, options = pickerOptions(actionsBox = TRUE)
         )
  ),
  column(6, tableOutput("tbl_w_flags"))
)

server <- function(input, output, session) {
  tbl <- reactiveVal()
  observe(tbl(switch(input$tbl, tbl1 = tbl1, tbl2 = tbl2)))
  
  observe(input$user_choices)
  
  observeEvent(input$flag_w_func, {
    old_tbl <- tbl()
    new_tbl <- flag_outliers(old_tbl)
    # Update reactive tbl and user_choice pickerInput
    tbl(new_tbl)
    new_choices <- new_tbl %>% filter(is_outlier) %>% pull(obs)
    updatePickerInput(session, "user_choices", selected = new_choices)
  })

  observeEvent(input$user_choices, {
    old_tbl <- tbl()
    new_tbl <- old_tbl %>% mutate(is_outlier = c(obs %in% input$user_choices))
    # Update reactive tbl()
    tbl(new_tbl)
  })
  output$tbl_w_flags <- renderTable(tbl())
}

shinyApp(ui, server)

编辑：
如果您想在小标题更改时重置选择器（使用单选按钮），请将您的第一个观察者更改为

observe({
  tbl(switch(input$tbl, tbl1 = tbl1, tbl2 = tbl2))
  updatePickerInput(session, "user_choices", selected = character(0))
})

单击按钮时更新小标题和下拉菜单；在下拉列表中做出选择时更新标题

Update a tibble and a dropdown when a button is clicked; update the tibble when choices are made in the dropdown

r

shiny

shiny-reactivity