The following code seems to always increase memory use. Is there a memory leak?
This is an extract of using multiple tabs to display multiple plots. It uses ggplotGlob to create multiple groups of plots. When object_size (output) is used, the value seems to always be increasing, event when 10 tabs 3 groups of 10 plots each and then tab 1 is changed to 1 group of 1 plot. In the full application this increasing memory use eventually leads to a segment fault.
library(shiny)
library(pryr)
library(ggplot2)
library(grid)
library(gridExtra)
totalTabs <<- 1
lastMemorySize <<- 0
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("test"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("tabNumber",
"Tab Number to use:",
min = 1,
max = totalTabs,
value = 1),
sliderInput("ngroups",
"Number of groups:",
min = 1,
max = 3,
value = 1),
sliderInput("nplots",
"Number of plots in each group:",
min = 1,
max = 10,
value = 30),
actionButton(inputId = "addTab", label = "Update Tab" ),
textOutput("memoryValue")
),
# Show a plot of the generated distribution
mainPanel(
uiOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
rv <- reactiveValues(
plotList = list()
)
output$memoryValue <- renderText ({
input$tabNumber
input$ngroups
input$nplots
input$addTab
currentSize <- object_size(output)
diff <- currentSize - lastMemorySize
lastMemorySize <- currentSize
if(diff < 0) browser()
str <- paste("Difference in output memory:", diff )
})
clearPlots <- function () {
if (length(rv$plotList) == 0) return ()
if (length(rv$plotList) < input$tabNumber) return ()
if (is.null(rv$plotList[[input$tabNumber]])) return()
if (is.na(rv$plotList[[input$tabNumber]])) return()
for (g in 1:rv$plotList[[input$tabNumber]][["groups"]]) {
plotname <- rv$plotList[[input$tabNumber]][["name"]][[g]]
output[[plotname]] <- NULL
}
rv$plotList[[input$tabNumber]] <- list()
}
observeEvent(input$addTab, {
addNewTab()
})
addNewTab <- function() {
clearPlots()
if (input$tabNumber == totalTabs) {
totalTabs <<- totalTabs + 1
updateSliderInput(session, inputId = "tabNumber", label = "Tab Number to use:",
value = input$tabNumber, min = 1, max = totalTabs, step = 1)
}
p <- list()
df <- list()
pgrob <- list()
plt <- list()
rv$plotList[[input$tabNumber]] <- list()
for (g in 1:input$ngroups) {
p[[g]] <- list()
pgrob[[g]] <- list()
for (i in 1:input$nplots) {
df[[i]] <- as.data.frame(matrix(rexp(20, rate=.1), ncol=2))
colnames(df[[i]]) <- c("x", "y")
p[[g]][[i]] <- qplot(x,y,data = df[[i]])
pgrob[[g]][[i]] <- ggplotGrob(p[[g]][[i]])
}
plotname <- paste0("plot-", input$tabNumber, "-", g)
rv$plotList[[input$tabNumber]][["groups"]] <- input$ngroups
rv$plotList[[input$tabNumber]][["name"]][[g]] <- plotname
ncols <- 3
if (ncols < 3) ncols <- input$nplots
output[[plotname]] <- renderPlot ( {
if (input$nplots == 1)
p[[g]][[i]]
else
do.call("grid.arrange", c(pgrob[[g]], top = paste("Group", g, "with", input$nplots, "Images"), ncol = ncols))
})
}
}
output$distPlot <- renderUI({
plt <- list()
if (length(rv$plotList) == 0) return ()
if (length(rv$plotList) < input$tabNumber) return ()
for(g in 1:rv$plotList[[input$tabNumber]][["groups"]]) {
plotname <- rv$plotList[[input$tabNumber]][["name"]][[g]]
plt[[g]] <- plotOutput(plotname)
}
if (length(plt) == 0)
return (NULL)
else
return(plt)
})
}
# Run the application
shinyApp(ui = ui, server = server)