How to avoid infinity loop while using purrr::map, R6 classes, gargoyle and Shiny?

Hello!

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. What I am trying to achieve is use this module to take in data from the R6 object, create filters based on it's columns and filter the R6 data based on this (by updating the filter field of the R6 object).
However, I'm facing an error in the server observe part: when the gargoyle trigger function is run it triggers the observe it is inside and thus run itself again. This causes an infinity loop. My question is, how can I have the module react on changes in the input through the purrr::map and then trigger the gargoyle::on function without causing this infinity loop?

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 you comment out gargoyle::trigger("df_r6_filtered") you can see that the normal reactive component based table works as expected.

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)
  
}

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.