Memory leak when using ggplot2, grobs, and tabs. Shiny or my bug?

[dcellis1950]

The following code seems to use new memory for each set of plots and does not release the old.

rm(list = ls())
library(shiny)
library(pryr)
library(ggplot2)
library(grid)
library(gridExtra)
library(startup)

totalTabs <<- 1




# Define UI for application
ui <- fluidPage(

    # Application title
  titlePanel("Memory Leak Test"),

  sidebarLayout(
    sidebarPanel(
      actionButton("addTab", label = "Add Tab"),
      actionButton("browser", label = "Enter Browser")
    ),


    mainPanel(
      tabsetPanel(id = "tabs")  #,
#      dataTableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  env <<- list()
  tabNumber <<- 0
  maxTab <<- 0
  # mymem = data.frame(ngroups = c(NA), nplots = c(NA), p1Size = c(NA), pgrobSize = c(NA), pltSize= c(NA),
  #                      outputSize = c(NA), memSize = c(mem_used()))


  rv <- reactiveValues(
    addTab = 0,
    newTable = FALSE
  )

  onStop( function () {
    if (! is.null(env[[tabNumber]])) {
  cat (paste("  ", object_size(output), mem_used(), "\n"), file = stderr())
      local( {
        rm(list = ls())
        gc()
      }, envir = env[[tabNumber]])
      rm(list = ls())
      gc()
  cat (paste("  ", object_size(output), mem_used(), "\n"), file = stderr())
  #    startup::restart(status = -1)
    }
  } )



  observeEvent(input$ngroups, {  rv$newTable <- rv$newTable + 1} )
  observeEvent(input$nplots, {  rv$newTable <- rv$newTable + 1} )

  observeEvent(input$tabs, {
    tabNumber <<- as.integer(input$tabs)
    rv$newTable <- rv$newTable + 1
  } )
  observeEvent(input$browser, { browser() } )

  observeEvent(input$addTab, {

    maxTab <<- maxTab + 1
    tabNumber <<- maxTab

    if (length(env) >= tabNumber) {
      rm(list = ls(env[[tabNumber]]))
      gc()
    } else {
      env[[tabNumber]] <<- new.env()
    }

    env[[tabNumber]]$plt <- list()
    env[[tabNumber]]$pgrob <- list()
    env[[tabNumber]]$p1 <- list()

    thisTab <- paste(tabNumber)

    appendTab (inputId = "tabs", tabPanel(thisTab, {
      sidebarLayout(
        fluid = TRUE,
        sidebarPanel (
          sliderInput(paste0("ngroups", tabNumber),
                      "Number of groups:",
                      min = 1,
                      max = 3,
                      value = 2),
          sliderInput(paste0("nplots", tabNumber),
                      "Number of plots in each group:",
                      min = 1,
                      max = 50,
                      value = 2)
        ),  # end sidebarPanel
        mainPanel (
          renderUI ( {
            assign("ngroups", input[[paste0("ngroups", tabNumber)]], envir = env[[tabNumber]])
            assign("nplots", input[[paste0("nplots", tabNumber)]], envir = env[[tabNumber]])
            rtn <- createPlots(ngroups = ngroups, nplots = nplots)
          } )  # end renderUI
        ) # end mainPanel
      )  # end sidebarLayout

    } ), select = TRUE)  # end appendTab
    rv$newTable <- rv$newTable + 1
    updateTabsetPanel(session = session, inputId = "tabs", selected = thisTab )
    Sys.sleep(1)
  } )


  createPlots <- function (ngroups, nplots) {
    rtn <- local ( {
      cat (paste("  ", object_size(output), mem_used(), "\n"), file = stderr())
      # currentOutputSize <- object.size(output)
      # currentMemorySize <- mem_used()


       df <- list()

       if (length(p1) > 0) {
         for (g in 1:length(p1)) {
          for (i in 1:length(p1[[g]])) {
            p1[[g]][[i]] <- NULL
            pgrob[[g]][[i]] <- NULL
          }
         }
       }
       for (g in 1:ngroups) {
         p1[[g]] <- list()
         pgrob[[g]] <- list()
       }

      for (g in 1:ngroups) {
        for (i in 1:nplots) {
          df[[i]] <- as.data.frame(matrix(rexp(20, rate=.1), ncol=2))
          colnames(df[[i]]) <- c("x", "y")
          p1[[g]][[i]] <- qplot(x,y,data = df[[i]])
          pgrob[[g]][[i]] <- ggplotGrob(p1[[g]][[i]])
        }

        ncols = 3
        if (nplots < 3) ncols <- nplots

        plotname <-   paste0("plot-", tabNumber, "-", g)
        output[[plotname]] <- renderPlot  ( {
          grid <- do.call("grid.arrange", c(pgrob[[g]], name = plotname, top = paste("Group", g, "with", nplots, "Images"), ncol = ncols))
          grid
        } )
        nrows <- ceiling(nplots/ncols)
        plt[[g]] <- plotOutput(plotname, height = paste0(nrows * 100, "px"))
      }

      # newRow <- data.frame(ngroups = ngroups, nplots = nplots, p1Size = as.integer(object.size(p1)),
      #                      pgrobSize = as.integer(object_size(pgrob)), pltSize = as.integer(object_size(plt)),
      #                      outputSize = as.integer(object_size(pgrob)), memSize = as.integer(mem_used()))
      # mymem <<- rbind (mymem, newRow)


      cat (paste(ngroups, nplots, object_size(p1), object_size(pgrob), object_size(plt)), file = stderr())
      plt
    } , envir = env[[tabNumber]])

    output[["table"]] <- renderDataTable(mymem)
    rtn
  }
}

# Run the application
shinyApp(ui = ui, server = server)

The problem seems to be that the 'output' object data is never released to be collected .

To run this app, start it and then click 'Add Tab'. Multiple tabs can be used, but for testing using one or two tabs is best. Next change the 'Number of groups' or 'Number of plots in each group.' It may take some time for large number of plots to display. Continue to change ngroups and nplots.

Clicking on 'Enter Browser' will drop you into debug mode when on Rstudio or within R.

The stderr() output is as follows:

1. The first line is object_size(output) and mem_used() before any plot are created.
2. The data lines are created by cat (paste(ngroups, nplots, object_size(p1), object_size(pgrob), object_size(plt)), file = stderr()) and cat (paste(" ", object_size(output), mem_used(), "\n"), file = stderr()) after the the plots are displayed. The ngroups is number of groups selected and nplots is the number plots for each group. The variable p1 is a list of plots created. The variable pgrob is a list of GROBs create using ggplotGrob on each p1 plot. The variable plt is a list of display objects passed back to the uiOutput shiny function.
3. After the plots are displayed, the object_size(output) and mem_used() is displayed.
4. Once the application is exited, all variables are removed, garbage collection is run, and the values of object_size(output) and mem_used() are displayed again.

Some examples of output:

Listening on http://127.0.0.1:5263
   2376080 221811760 
2 2 773272 392456 2392   7092784 221843712 
2 25 1850776 4778160 2392   61092640 284092072 
3 25 2436440 7152784 3120   140786624 374046392 
3 45 3841880 12867424 3120   284032792 535600168 
3 3 890480 868920 3120   293851312 534730176 
3 10 1382504 2868264 3120   325881872 571541040 
1 10 1148184 1915696 3120   338829016 582040176 
   337213896 581077008 

and

Listening on http://127.0.0.1:5263
   2375648 586882768 
2 2 773272 391880 2392   7095328 592037232 
3 2 820184 581432 3120   13711184 599485232 
3 48 4052696 13724808 3120   166430312 778515936 
3 49 4122968 14009032 3120   322396608 948693360 
3 50 4193240 14301048 3120   481563696 1122385960 
3 49 4122968 14006136 3120   637415032 1291871816 
3 6 1101272 1721288 3120   656688344 1301017008 
3 50 4193240 14296544 3120   815683160 1486329392 
3 3 890480 869784 3120   825521496 1484103904 
3 47 3982424 13441216 3120   975139168 1659234784 
3 1 749912 296704 3120   978608720 1650352440 
3 49 4122968 14003176 3120   1134495520 1833392088 
3 5 1031024 1438088 3120   1150651400 1838880608 
3 50 4193240 14294840 3120   1309717960 2024551368 
3 5 1031024 1442000 3120   1325923128 2029823800 
3 49 4122968 14010832 3120   1481809840 2211758264 
1 49 2951768 9254856 3120   1537025936 2263134432 
2 49 3256312 10486368 3120   1642513248 2380882280 
3 49 4122968 14005568 3120   1811847840 2556581176 
2 2 773272 394752 2392   1799622624 2557143512 
2 49 3537368 11634368 3120   1905193648 2666535040 
2 26 2178808 6111552 3200   1965362448 2723984872 
   1961390856 2719833288 

As you can see the values or p1, pgrob, and plt vary as expected, but object_size(output) continues to rise. The mem_size() also generally tracks the output size. Running rm(list=ls()) does not seem to remove most of this memory.

I have run this app until I have accumulated more that 4 GB a memory. The Linux system application top also shows this accumulation of memory.

In a previous post, when Tabs were not being used, a work around was to alway display the same number of groups, using blank plots to fill in group plots above ngroups. This was tried here, but does ot work with tabs.

It is possible that I have a bug in my code, but I have tried every thing I can think of and the memory leak is still there. Automatic garbage collection is nice when it works, but a nightmare when it doesn't.

[winston]

I don't think that it has to do with ggplot2 or grid. I think it instead has something to do with calling renderPlot() repeatedly, from the renderUI(). Here's a simplified version of an app from one of your previous posts. It also calls renderPlot() from within renderUI() and looks like it has a memory leak, but it doesn't use grid or ggplot2:

rm(list = ls())
library(shiny)
library(pryr)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("nplots", "Number of plots:", min = 1, max = 5, value = 2),
      actionButton(inputId = "updateMemory", label = "Display Current Memory Values" ),
      verbatimTextOutput("memoryValue")
    ),
    mainPanel(
      uiOutput("plots")
    )
  )
)


server <- function(input, output, session) {
  output$plots <- renderUI({
    plt <- list()
    for (g in 1:input$nplots) {
      plotname <- paste0("plot-", g) 
      output[[plotname]] <- renderPlot({
        plot(1:20, 1:20)
      })
      plt[[g]] <- plotOutput(plotname)
    }
    return(plt)
  })
  
  output$memoryValue <- renderText ({
    input$nplots
    input$ngroups
    input$updateMemory
    gc()
    str <- HTML(paste(
      "output object size (MB):",
      format(object_size(output)/ 1024 / 1024, format = "f", digits = 2), 
      "\ntotal memory:",
      formatC(mem_used() / 1024 / 1024, format = "f", digits = 2) 
    ))
  })  
}

shinyApp(ui = ui, server = server)

In general, if you're calling renderPlot() over and over again (instead of letting the expression in renderPlot() be re-executed automatically in response to changing inputs), that's usually a sign that the code isn't structured efficiently. I suggest rewriting your code to avoid that pattern. That said, it does look like there's some sort of leak going on, and we will investigate it.

[barret]

Hi @dcellis1950,

I believe I have made a trimmed version of your application without the memory leak.

As @winston suggested, I moved renderPlot outside of renderUI.

Code design ideas implemented:

• Try to avoid using environments manually. Instead, use functions with function arguments to set values to be used in a certain execution scope.
• Decouple generating the UI definition with the plot creations. renderUI should only be receiving UI definitions. Plots should be created only within renderPlot calls.
• For every new tab, only call render* methods once (and avoid nesting render* methods. Let the reactivity do the heavy lifting. If a render method is currently invalid, but possible later, have the shiny::req method determine that logic and quit early. Notice how the lapply from 1:3 will only ever be called if a new tab is created. The third group plot will be attempted but will pre-empt on the first pass.

rm(list = ls())
library(shiny)
library(pryr)
library(ggplot2)
library(grid)
library(gridExtra)
library(startup)

totalTabs <<- 1

# Define UI for application
ui <- fluidPage(
  
  # Application title
  titlePanel("Memory Leak Test"),
  
  sidebarLayout(
    sidebarPanel(
      actionButton("addTab", label = "Add Tab"),
      actionButton("browser", label = "Enter Browser")
    ),
    
    mainPanel(
      tabsetPanel(id = "tabs")
    )
  )
)

server <- function(input, output, session) {
  maxTab <- 0

  observeEvent(input$addTab, {
    
    maxTab <<- maxTab + 1
    tabNumber <- maxTab
    
    thisTab <- paste(tabNumber)
    
    # get ngroups and nplots for this particular tab
    ngroups <- reactive({
      val <- input[[paste0("ngroups", tabNumber)]]
      req(val) # require the value for reactivity to work
      val
    })
    nplots <- reactive({
      val <- input[[paste0("nplots", tabNumber)]]
      req(val)
      val
    })
    
    # name helper method
    plot_loc <- function(g) {
      paste0("plot-", tabNumber, "-", g)
    }
    
    # generate the plot UI information only
    plot_ui <- reactive({
      req(ngroups(), nplots())
      lapply(1:ngroups(), function(g) {
        ncols <- 3
        if (nplots() < 3) ncols <- nplots()
        
        nrows <- ceiling(nplots() / ncols)
        plotOutput(plot_loc(g), height = paste0(nrows * 100, "px"))
      })
    })
    # set the plot UI information
    output[[paste0("main-", tabNumber)]] <- renderUI({
      plot_ui()
    })
    
    # create the plots each time the groups or nplots change
    plots <- reactive({
      req(ngroups(), nplots())
      lapply(1:ngroups(), function(g) {
        make_plot(nplots(), plot_loc(g), paste("Group", g, "with", nplots(), "Images"))
      })
    })
  
    # print memory statistics every time the plots are updated
    observe({
      plots()
      cat(paste0(
        "  output: ", capture.output(print(object_size(output))), 
        ", mem used: ", capture.output(print(mem_used())), 
        "\n"), 
        file = stderr()
      )
    })
    
    # for all possible groups, render a plot
    # if a group is not to be drawn, return early 
    lapply(1:3, function(g) {
      output[[plot_loc(g)]] <- renderPlot({
        p <- plots()
        req(g <= length(p)) # return early if not available
        pg <- p[[g]]
        grid.draw(pg)
      })
    })
    
    appendTab (inputId = "tabs", tabPanel(thisTab, {
      sidebarLayout(
        fluid = TRUE,
        sidebarPanel (
          sliderInput(paste0("ngroups", tabNumber),
                      "Number of groups:",
                      min = 1,
                      max = 3,
                      value = 2),
          sliderInput(paste0("nplots", tabNumber),
                      "Number of plots in each group:",
                      min = 1,
                      max = 50,
                      value = 2)
        ),  # end sidebarPanel
        mainPanel(
          # put in ui with tab number
          uiOutput(paste0("main-", tabNumber))
        ) # end mainPanel
      )  # end sidebarLayout
      
    } ), select = TRUE)  # end appendTab
    
    updateTabsetPanel(session = session, inputId = "tabs", selected = thisTab )
    
    Sys.sleep(1)
  })
  
  # generate a grob of plots
  make_plot <- function(nplots, plotname, top) {
    pgrob <- lapply(1:nplots, function(i) {
      df <- as.data.frame(matrix(rexp(20, rate=.1), ncol=2))
      colnames(df) <- c("x", "y")
      p <- qplot(x,y,data = df)
      ggplotGrob(p)
    })
    
    ncols = 3
    if (nplots < 3) ncols <- nplots
    
    do.call(
      "arrangeGrob", # use arrangeGrob to avoid printing. (will draw at a later date)
      c(      
        pgrob, 
        name = plotname, 
        top = top, 
        ncol = ncols
      )
    )
  }
  
}

# Run the application
shinyApp(ui = ui, server = server)

Listening on http://127.0.0.1:6004
  output: 3.02 MB, mem used: 236 MB
  output: 7.47 MB, mem used: 241 MB
  output: 9.6 MB, mem used: 244 MB
  output: 10.8 MB, mem used: 245 MB
  output: 7.35 MB, mem used: 241 MB
  output: 7.9 MB, mem used: 242 MB
  output: 10.4 MB, mem used: 245 MB
  output: 7.63 MB, mem used: 242 MB
  output: 7.35 MB, mem used: 242 MB

It is possible the printing of the output memory was done out of order, but both the output memory and overall memory decreased at some time points.

Hope this helps!

- Barret

[dcellis1950]

Thanks to both Barret and Winston for the help. This solved my problem.

[winston]

I've filed an issue about memory leaks related to renderPlot() here:
https://github.com/rstudio/shiny/issues/2423

[dcellis1950]

One more problem I am encountering, how do you modify the previous code to add a "Display Plots" actionButton to allow the user to change multiple settings before the plots are recalculated?
I am getting close to a dead line on this project and am really burned out. Thanks for your help.

Sorry figured it out, simple. I told you I was burned out. Looking at the same code too much can fry your brain when you get old. To let you know how old, my first programming language was Fortran IV.