Использование R ggplot2 grobs для отображения графиков.Это вызывает утечку памяти? - PullRequest
2 голосов
/ 02 апреля 2019

Следующий код, кажется, всегда увеличивает использование памяти.Есть ли утечка памяти?Является ли object_size (output) хорошей мерой памяти, используемой UI?Разве я не понимаю, как R восстанавливает память?

Это упрощенная выдержка из приложения, которое использует несколько вкладок для отображения нескольких графиков.Он использует ggplotGlob для создания нескольких групп графиков.Когда используется object_size (output), значение всегда увеличивается.Когда создаются 10 вкладок с 3 группами по 10 графиков в каждой, а затем вкладка 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)



...