Why is this Shiny app code not reactive when using purrr:map over input variables?

Question

EDIT WITH MWE BELOW

I have below a snippet of my code which is part of a larger app. I'm trying to rewrite the app to work with R6 classes and gargoyle as per this article. However, I cannot figure out why the observe part of the data below does not trigger except when it's initialized. To my understanding should if observe all the filters that are in input based on the map function, am I wrong?

  output$filters <- renderUI({
    gargoyle::watch("first thing")
    data <- Data$get_data(unfiltered = TRUE)
    data_names <- names(data)
    if(nrow(data) > 0){
      map(data_names, ~ render_ui_filter(data[[.x]], .x))
    }
  }
  )


observe({
  data <- Data$get_data(unfiltered = TRUE)
  data_names <- names(data)
  if(ncol(data) > 0){
    each_var <- map(data_names, ~ filter_var(data[[.x]], input[[paste0("filter",.x)]]))
    Transactions <- Data$set_filters(reduce(each_var, `&`))
    gargoyle::trigger("second thing")
  }
})

I've had a working case of the second reactive element like this:

  selectedData <- reactive({
    if(nrow(data()) > 0){
      each_var <- map(dataFilterNames(), ~ filter_var(data()[[.x]], input[[paste0("filter",.x)]]))
      reduce(each_var, `&`)
    }
  })

where data and dataFilterNames are reactiveVal and dataFilterNames is the column names of data.

Here you can find render_ui_filter and filter_var:

render_ui_filter <- function(x, var) {
    if(all(is.null(x) | is.na(x))){
      #If all data is null, don't create a filter from it
      return(NULL)
    }
    id <- paste0("filter",var)
    var <- stringr::str_to_title(var)
    if (is.numeric(x)) {
      if(is.integer(x)){
        step = 1
      }
      else{
        step = NULL
      }
      rng <- range(x, na.rm = TRUE)
      sliderInput(id,
                  var,
                  min = rng[1],
                  max = rng[2],
                  value = rng,
                  round = TRUE,
                  width = "90%",
                  sep = " ",
                  step = step
      )
    } else if (is.factor(x)) {
      levs <- levels(x)
      if(length(levs) < 5){
        pickerInput(id, var, choices = levs, selected = levs, multiple = TRUE,
                    options = list(
                      title = sprintf("Filter on %s...", var),
                      #`live-search` = TRUE,
                      #`actions-box` = TRUE,
                      size = 10
                    ))
      }else {
        pickerInput(id, var, choices = levs, selected = levs, multiple = TRUE,
                    options = list(
                      title = sprintf("Filter on %s...", var),
                      `live-search` = TRUE,
                      `actions-box` = TRUE,
                      size = 10,
                      `selected-text-format` = "count > 5"
                    ))
      }
    } else if (is.Date(x)){
      dateRangeInput(id,
                     var,
                     start = min(x),
                     end = max(x),
                     weekstart = 1,
                     autoclose = FALSE,
                     separator = "-")
    } else if (is.logical(x)) {
      pickerInput(id, var, choices = unique(x), selected = unique(x), multiple = TRUE,
                  options = list(
                    title = sprintf("Filter on %s...", var),
                    `live-search` = TRUE,
                    #`actions-box` = TRUE,
                    size = 10
                  ))
    } else {
      # Not supported
      NULL
    }
  }

  filter_var <- function(x, val) {
    if(all(is.null(x) | is.na(x))){
      #If all data is null, don't create a filter from it
      return(TRUE)
    }
    if (is.numeric(x)) {
      !is.na(x) & x >= val[1] & x <= val[2]
    } else if (is.factor(x)) {
      x %in% val
    } else if(is.Date(x)){
      !is.na(x) & x >= val[1] & x <= val[2]
    } else if (is.logical(x)) {
      x %in% val
    } else {
      # No control, so don't filter
      TRUE
    }
  }

Edit: Here is a MWE that can be run in a notebook for example. It does not currently work since the gargoyle trigger triggers the observe it is in and we end up in a infinity loop. If you remove that you can see that the normal reactive part works, but the R6 version does not create the table ever.

if (interactive()){
  require("shiny")
  require("R6")
  require("gargoyle")
  require("purrr")
  require("stringr")
  
  # R6 DataSet ----
  DataSet <- R6Class(
  "DataSet",
  private  = list(
    .data = NA,
    .data_loaded = FALSE,
    .filters = logical(0)
  ),
  public = list(
    initialize = function() {

      private$.data = data.frame()
    },
    get_data = function(unfiltered = FALSE) {
      if (!unfiltered) {
        return(private$.data[private$.filters, ])
      }
      else{
        return(private$.data)
      }
    },
    set_data = function(data) {
      stopifnot(is.data.frame(data))
      private$.data <- data
      private$.data_loaded <- TRUE
      private$.filters <- rep(T, nrow(private$.data))
      return(invisible(self))
    },
    set_filters = function(filters) {
      stopifnot(is.logical(filters))
      private$.filters <- filters
    }
  )
)
  # Filtering ----
  render_ui_filter <- function(x, var) {
      if(all(is.null(x) | is.na(x))){
        #If all data is null, don't create a filter from it
        return(NULL)
      }
      id <- paste0("filter",var)
      var <- stringr::str_to_title(var)
      if (is.numeric(x)) {
        if(is.integer(x)){
          step = 1
        }
        else{
          step = NULL
        }
        rng <- range(x, na.rm = TRUE)
        sliderInput(id,
                    var,
                    min = rng[1],
                    max = rng[2],
                    value = rng,
                    round = TRUE,
                    width = "90%",
                    sep = " ",
                    step = step
        )
      }  else {
        # Not supported
        NULL
      }
    }
  
  filter_var <- function(x, val) {
  if(all(is.null(x) | is.na(x))){
    #If all data is null, don't create a filter from it
    return(TRUE)
  }
  if (is.numeric(x)) {
    !is.na(x) & x >= val[1] & x <= val[2]
  } else {
    # No control, so don't filter
    TRUE
  }
}
  # Options ----
  options("gargoyle.talkative" = TRUE)
  options(shiny.trace = TRUE)
  options(shiny.fullstacktrace = TRUE)

  
  ui <- function(request){
    tagList(
      h4('Filters'),
      uiOutput("transactionFilters"),
      h4('Reactive'),
      tableOutput("table_reactive"),
      h4('R6'),
      tableOutput("table_r6")
    )
  }
  
  server <- function(input, output, session){
    
    gargoyle::init("df_r6_filtered")
    
    
    
    Name <- c("Jon", "Bill", "Maria", "Ben", "Tina")
    Age <- c(23, 41, 32, 58, 26)
    
    df <- reactive(data.frame(Name, Age))
    
    df_r6 <- DataSet$new()
    df_r6$set_data(data.frame(Name, Age))
    
    output$transactionFilters <- renderUI(
      map(names(df()), ~ render_ui_filter(x = df()[[.x]], var = .x))
    )
    
    selected <- reactive({
      if(nrow(df()) > 0){
        each_var <- map(names(df()), ~ filter_var(df()[[.x]], input[[paste0("filter",.x)]]))
        reduce(each_var, `&`)
      }
    })
    
  observe({
    data <- df_r6$get_data(unfiltered = TRUE)
    data_names <- names(data)
    if(ncol(data) > 0){
      each_var <- map(data_names, ~ filter_var(data[[.x]], input[[paste0("filter",.x)]]))
      filters_concatted <- reduce(each_var, `&`)
      df_r6$set_filters(filters_concatted)
      gargoyle::trigger("df_r6_filtered")
    }

  })
    
    
    output$table_reactive <- renderTable(df()[selected(),])
    gargoyle::on("df_r6_filtered",{
      output$table_r6 <- renderTable(df_r6$get_data())
    })
    
  }
  
  shinyApp(ui, server)
  
}

EDIT2: I noticed that the gargoyle::trigger("df_r6_filtered") creates a infinity loop of triggering the observe component. I'm not sure how to get out of it and that's what I am looking for help with.

Answer 1

The answer was simpler then expected of course. Just change the observe to a observeEvent on all of the input elements regarding the filter, i.e. like this:

observeEvent(
      eventExpr = {
        data <- df_r6$get_data(unfiltered = TRUE)
        data_names <- names(data)
        map(data_names, ~ input[[paste0("filter",.x)]])
      },
      {
        ...
        }
      })