使用函数在 Shiny 中的 reactiveValues 对象中生成反应值

Use a function to generate reactive values in a reactiveValues object in Shiny

我有许多要在 {Shiny} reactiveValues 对象中创建的反应元素,所有这些元素都需要几乎相同的过滤代码。但我不知道如何有效地做到这一点,即不直接为每个元素编写过滤代码。在下面的示例代码中,一个单选按钮控制将一些数据过滤为 2 组,A 和 B。好的和坏的输出之间的区别在于坏的输出使用函数来定义它的值,而好的输出有它指定直接作为 reactive 对象。

当使用函数为坏的值创建值时,它似乎停留在初始值,因为当通过 selecting 不同的组更改数据时它不会改变。然而,好的确实正确地过滤了数据。那么我们如何在 reactiveValues 对象中使用相同的代码创建多个元素呢?

library(shiny)

ui <- fluidPage(
  radioButtons(
    "group", "",
    list(A = "A", B = "B"), list("A"),
    inline = TRUE
  ),
  actionButton("go", "Go"),
  textOutput("filtered_data_bad"),
  textOutput("filtered_data_good")
)

server <- function(input, output) {

  data <- tibble(
    group = rep(c("A", "B"), c(5, 10))
  )

  group_saved <- reactiveVal(value = c("A"))

  observeEvent(
    input$go,
    group_saved(input$group),
    ignoreInit = TRUE,
    ignoreNULL = FALSE
  )

  filter_data <- function (.data, .group) {
    reactive(
      .data[.data$group %in% .group,]
    )
  }

  format_text <- function (.data, .group) {
    req(nrow(.data) > 0)
    paste(
      "Selected:",
      nrow(.data),
      "total"
    )
  }

  rv <- reactiveValues(
    bad  = filter_data(data, group_saved()),
    good = reactive(
      data[data$group %in% group_saved(),]
    )
  )

  output$filtered_data_bad <- renderText({
    format_text(rv$bad(), group_saved())
  })

  output$filtered_data_good <- renderText({
    format_text(rv$good(), group_saved())
  })
}

shinyApp(ui, server)

上面的代码是我在展示问题时所能得到的最简单的代码。我正在处理这样的要求,即能够从一个共同的选择池(实际上是地理区域)中同时 select 许多不同的组,为此 reactiveValues 将为每个组保留一组选择。每个组都有自己的 reactiveVal 对象(saved_regions_Asaved_regions_B、...)用作过滤器。

regions_saved_A <- reactiveVal(value = regions)
regions_saved_B <- reactiveVal(value = NULL)
regions_saved_C <- reactiveVal(value = NULL)
...

filter_data <- function (.data, .regions) {
  reactive(.data %>% filter(region %in% .regions))
}

filtered_data <- reactiveValues(
  A = filter_data(data, regions_saved_A()),
  B = filter_data(data, regions_saved_B()),
  C = filter_data(data, regions_saved_C()),
  ...
)

我已经尝试从函数中删除 reactive 调用并使用每个值的函数调用来调用它(这似乎是必需的,因为我依赖 reactiveVal 来保存选择). None 以下作品:

filter_data <- function (.data, .regions) {
  .data %>% filter(region %in% .regions)
}

filtered_data <- reactiveValues(
  A = reactive(filter_data(data, regions_saved_A())),
  B = filter_data(data, regions_saved_B()),
  ...
)

observer 中分配 reactiveValues。不需要让他们再次反应。试试这个

library(shiny)

ui <- fluidPage(
  radioButtons(
    "group", "",
    list(A = "A", B = "B"), list("A"),
    inline = TRUE
  ),
  actionButton("go", "Go"),
  textOutput("filtered_data_bad"),
  textOutput("filtered_data_good")
)

server <- function(input, output) {
  
  data <- tibble(
    group = rep(c("A", "B"), c(5, 10))
  )
  
  group_saved <- reactiveVal(value = c("A"))
  
  observeEvent(
    input$go,
    group_saved(input$group),
    ignoreInit = TRUE,
    ignoreNULL = FALSE
  )
  
  filter_data <- function (df, .group) {
    df[df$group %in% .group,]
    
    # reactive(
    #   .data[.data$group %in% .group,]
    # )
    
  }
  
  format_text <- function (.data, .group) {
    req(nrow(.data) > 0)
    paste(
      "Selected:",
      nrow(.data),
      "total"
    )
  }
  
  rv <- reactiveValues(bad=NULL,good=NULL)
  
  observeEvent(input$go, {
    group_saved()
    rv$bad  = filter_data(data, group_saved())
    rv$good = data[data$group %in% group_saved(),]
  })
  
  output$filtered_data_bad <- renderText({
    req(rv$bad)
    format_text(rv$bad, group_saved())
  })
  
  output$filtered_data_good <- renderText({
    req(rv$good)
    format_text(rv$good, group_saved())
  })
}

shinyApp(ui, server)