R Shiny Memory Leak - Suggestions on how to find?

2019-03-06 08:36发布

I'm looking for general ideas on how to identify Memory leaks in a shiny program for R. I'm struggling to identify exactly where the leak is coming from, so it's hard to recreate, and my code is already over 1000 lines. I'm sure it's related to observe and observeevents, but I can't exactly pinpoint it. I actually liked the idea proposed here by bborgeser, using the options, reactlog: https://github.com/rstudio/shiny/issues/1591 But when I try that, the showReactLog() won't load. I'm guessing my code is too large for that.

So my main question, is what's the best way to identify a memory leak? I'm using the pryr package to track the memory used after each time I submit. So I can tell the memory is increasing. I found a few other articles on memory leaks, but they are more on specific problems to solve, rather than a general question: https://github.com/rstudio/shiny/issues/931

Since some people work better seeing some actual code, I tried to do my best to recreate it more succinctly. This will increase it about .3 mb per. Maybe it's something to do with using lists upon lists? I've been playing around with my stuff for weeks now and not really making any progress.

In this code specifically, I know the memory leak is definitely in the Reactive/Observe. If I block those, the memory won't increase. But I'm sure you are able to use reactive and observe without increasing the memory. So this brings me back to my original question, in this case I found it by slowly blocking out sections, but even when I try that on my larger code I'm not really able to identify which section it's coming from. So how do people go about finding their leaks?

    #Library Load##########################################################################################
lapply(c("shiny","tidyverse","shinydashboard","shinyjs","pryr"),require,character.only = T)
#ui, shiny body#########################################################################################
body<-dashboardBody(
  useShinyjs(),
            ({
              tabs<-lapply(1:length(1:8), function(x){
                tabPanel(box(title = paste0('Tab ',x),  width = NULL),
                fluidPage(
                  div(id = paste0("BOX_",x),
                      column(width = 6, align = "center",
                          lapply(seq(1,15,2),function(y){
                              div(id = paste0("Box_ID_",x,"_",y),
                                  box(width = NULL, title = paste0("Reading",((y/2)+.5)),
                                      column(width = 4,
                                             numericInput(paste0("Number_",x,"_",y), label = paste0("Number - ",y), value = 0, min = 0, max = 60, step = .1)),
                                      column(width = 4,
                                             numericInput(paste0("Number_",x,"_",y+1), label = paste0("Number - ",y+1), value = 0, min = 0, max = 60, step = .1))))
                          })),
                      column(width = 2, align = "center",
                                 actionButton(paste0("Complete_",x),"Complete"))
                  )))
              }) 
              do.call(tabBox, c(tabs, list(width = NULL)))
            }))
##UI combination###################
ui<-dashboardPage(
  dashboardHeader(disable = T),
  dashboardSidebar(disable = T),
  body)
#######Server################
server <- function(input, output, session) {
  #Tab 1 - Reactive Average
  Avg<-reactive({
    lapply(1:8, function(x) {
      lapply(seq(1,15,2),function(y){
        req(input[[paste0("Number_",x,"_",y)]],input[[paste0("Number_",x,"_",y+1)]])
        if(input[[paste0("Number_",x,"_",y)]] == 0 | input[[paste0("Number_",x,"_",y+1)]] == 0) {0} else {
          (input[[paste0("Number_",x,"_",y)]]+input[[paste0("Number_",x,"_",y+1)]])/2}
      })
    })
  })

  #Tab 1 - Show or hide boxes
  lapply(1:8, function(x) {
    lapply(seq(1,15,2),function(y){
      observe({
        req(input[[paste0("Number_",x,"_",y)]],input[[paste0("Number_",x,"_",y+1)]])
        if(y == 1 & Avg()[[x]][[(y/2)+.5]] <= 30) {
          shinyjs::show(paste0("Box_ID_",x,"_",1))
          shinyjs::hide(paste0("Box_ID_",x,"_",3))
        } else if(y == 1 & Avg()[[x]][[(y/2)+.5]] > 30) {
          shinyjs::show(paste0("Box_ID_",x,"_",1))
          shinyjs::show(paste0("Box_ID_",x,"_",3))
        } else if(Avg()[[x]][[(y/2)+.5]] > 30) {
          shinyjs::show(paste0("Box_ID_",x,"_",y+2))
        } else {shinyjs::hide(paste0("Box_ID_",x,"_",y+2))}
      })
    })
  })

  #Tab 1 - Submit Button - Reset boxes, create data frame and append to file. 
  lapply(1:8,function(x){
    observeEvent(input[[paste0("Complete_",x)]],{
     #Reset the page
      reset(paste0("BOX_",x))
      #Garabage collect
      gc()
      #Print memory used. Tracking memory leaks
      print(mem_used())
    })
  })
}
shinyApp(ui, server)

0条回答
登录 后发表回答