使用R ggplot2 grobs显示图。这会导致内存泄漏吗?

时间:2019-04-02 13:21:16

标签: r ggplot2 shiny grob

以下代码似乎总是会增加内存使用量。有内存泄漏吗? 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)



0 个答案:

没有答案