Memory Leak using reactiveEvent

I have the following issue with my shiny app. I'm querying a database when an actionbutton is pressed and storing it as a dataframe. After that I make it a reactive so that it is responsive to changes in the input. This part works perfectly. The database is queried only when the search button is pressed. The table exposed to the user is fastly responsive to filters the user sets.
However, there is a memory leak. If during a session I perform 4 successive searches into the database, the memory builds up and is never freed.

tableMod <- function(input, output, session, dims, thresholds, cats, search) {
  
  table <- eventReactive(search(), {
    baseTable <- withProgress(
      queryDBOverview(dims, thresholds, cats),
      message = "querying database", value = 0.5
    )
    reactifyTable(baseTable, cats, thresholds, dims)
  })

  output$table <- renderDataTable(
    datatable(
      table()(),
      rownames = FALSE,
      selection = "none",
      options = list(pageLength = 100, lengthChange = FALSE, searching = FALSE, scrollX = TRUE,
                      autoWidth = TRUE, columnDefs = list(list(width = '1px', targets = "_all")))
    ) %>%
      formatPercentage("ctr", 2)
  )
}
reactifyTable <- function(table, cats, thresholds, dims) {
  print("reactify")

  reactive({

    # filter by categories
    table <- table %>%
      filter(day >= cats$from_date() && day <= cats$to_date())

    table <- table %>%
      execute_if(!is.null(cats$sources()),
                 filter(source_id %in% cats$sources())) %>%
      execute_if(!is.null(cats$sites()),
                 filter(site %in% cats$sites())) %>%
      execute_if(!is.null(cats$ad_types()),
                 filter(ad_type %in% cats$ad_types())) %>%
      execute_if(!is.null(cats$ad_sizes()),
                 filter(ad_size %in% cats$ad_sizes()))

    # group by dims and aggregate
    table %>%
      group_by_at(dims()) %>%
      summarise(
        imps = sum(imps, na.rm = TRUE),
        clicks = sum(clicks, na.rm = TRUE),
        jcost = sum(jcost, na.rm = TRUE),
        k_devid_freq = mean(k_devid_freq),
        sk_devid_freq = mean(sk_devid_freq),
        p95_devid_freq = mean(p95_devid_freq),
        k_ip_freq = mean(k_ip_freq),
        sk_ip_freq = mean(sk_ip_freq),
        p95_ip_freq = mean(p95_ip_freq),
        k_clickdelta = mean(k_clickdelta),
        sk_clickdelta = mean(sk_clickdelta),
        p95_clickdelta = mean(p95_clickdelta)
      ) %>%
      mutate(
        ctr = clicks / imps
      )

    # filter by performance
    table <- table %>%
      filter(
        imps >= thresholds$imps(),
        clicks >= thresholds$clicks(),
        ctr >= thresholds$ctr(),
        jcost >= thresholds$jcost()
      )

    table <- table %>%
      mutate_at(
        c("p95_devid_freq", "p95_ip_freq", "p95_clickdelta", "k_devid_freq", "k_ip_freq",
          "k_clickdelta", "sk_devid_freq", "sk_ip_freq", "sk_clickdelta"),
        ~rescale(.)
      )

    table
  })
}

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