2

以下代码似乎总是增加内存使用。有内存泄漏吗？object_size(output) 是衡量 UI 使用的内存的好方法吗？我不明白 R 是如何回收内存的吗？

这是使用多个选项卡显示多个绘图的应用程序的简化摘录。它使用 ggplotGlob 创建多组图。当使用 object_size (output) 时，该值似乎总是在增加。当创建 10 个选项卡时，每组 10 个绘图 3 组，然后选项卡 1 更改为 1 组 1 个绘图，object_size(output) 报告的内存量不会减少。在完整的应用程序中，当在 Docker 容器中使用闪亮服务器时，这种不断增加的内存使用最终会导致段错误。

在 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)
4

0 回答 0