以下代码似乎总是会增加内存使用量。有内存泄漏吗? UI是否正在使用object_size(output)来衡量内存使用情况?我不明白R如何回收内存吗?
这是使用多个选项卡显示多个图的应用程序的简化摘录。它使用ggplotGlob创建多组绘图。当使用object_size(输出)时,该值似乎总是在增加。当创建10个选项卡时,每个选项卡具有3组,每组10个图,然后将选项卡1更改为1组,每1个图,由object_size(output)报告的内存量不会减少。在整个应用程序中,这种增加的内存使用最终会导致在Docker容器中使用Shiny-server时出现段错误。
在RStudio中,由object_size(output)报告的内存仍会增加,但不会在30个绘图中崩溃。
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)