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

I have numerous reactive elements to create in a {Shiny} reactiveValues object, all requiring almost identical filtering code. But I cannot work out how to do this efficiently, i.e. without writing the filtering code directly for each element. In the sample code below, a radio button controls filtering of some data into 2 groups, A and B. The difference between the good and bad outputs is that the bad one uses a function to define its value, whereas the good one has it specified directly as a reactive object.

When using the function to create the value for the bad one, it seems to be stuck at the intial value, as when changing the data by selecting a different group it does not change. The good one does correctly filter the data however. So how could we create many elements with the same code in the reactiveValues object?

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)

The code above is as simple as I could get it while showing the issue. I am working with the requirement to be able to select many different groups simultaneously from a common pool of choices (geographical regions in fact), for which the reactiveValues will hold one set of choices per group. Each group has its own reactiveVal object (saved_regions_A, saved_regions_B, ...) that serves as the filter.

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()),
  ...
)

I have tried removing the reactive call from the function and calling it with the function call for each value (it seems to be needed as I am relying on a reactiveVal for the saved choices). None of the below work:

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()),
  ...
)

CodePudding user response：

Assign the reactiveValues in an observer. No need to make them reactive again. Try this

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)