Solving a memory leak - Shiny R

2019-04-16 22:56发布

问题:

I have a memory leak with my shiny program, and I'm struggling to figure it out. The leak I have is very small with the code I'll show, but for my actual code it is magnitudes larger in loss, accumulating gigabytes in days. I've been working on simplifying this, but still showing the issue, and this is the best I could come up with. I use three packages, shiny, shinyjs to reset the page, and pryr to show memory loss.

Essentially, just input numbers, and click the submit button to reset/print out memory. If the average of the first two numbers is above 5, it creates a second box. If the average is below 5 on either box, but not 0, then you can submit and reset.

    #Library Load##########################################################################################
lapply(c("shiny","shinyjs","pryr"),require,character.only = T)
#ui, shiny body#########################################################################################
ui<-fluidPage(
  useShinyjs(),
  #Div to reset the whole page upon submission
  div(id = paste0("BOX_"),
      h3("Add random numbers. If average is above 5, an additional box will be added. If below 5, click reset to reset the page and update memory"),
      #lapply - Add 2 boxes with double numeric inputs and average
      column(width = 5, align = "center",
      lapply(seq(1,3,2),function(y){
          div(id = paste0("Box_ID_","_",y),
                         numericInput(paste0("Number_",y), label = paste0("Number - ",y), value = 0, min = 0, max = 60, step = .1),
                         numericInput(paste0("Number_",y+1), label = paste0("Number - ",y+1), value = 0, min = 0, max = 60, step = .1),
                         h3(textOutput(paste0("Avg_",y))))
      })),
      column(width = 1),
      #Submit and memory used#########
          actionButton(paste0("Complete_"),"Reset"),
          br(),
      h4("Memory output - Updates on submit"),
      textOutput(paste0("Memory"))
))
#######Server################
server <- function(input, output, session) {
  #Reactive Average#########
  Avg<-reactive({
    lapply(seq(1,3,2),function(y){
      req(input[[paste0("Number_",y)]],input[[paste0("Number_",y+1)]])
      if(input[[paste0("Number_",y)]] == 0 | input[[paste0("Number_",y+1)]] == 0) {0} else {
        (input[[paste0("Number_",y)]]+input[[paste0("Number_",y+1)]])/2}
    })
  })
  #Average Output##########
  lapply(seq(1,3,2),function(y){
    output[[paste0('Avg_',y)]] <- renderText({
      req(input[[paste0("Number_",y)]],input[[paste0("Number_",y+1)]])
      if(input[[paste0("Number_",y)]] == 0 | input[[paste0("Number_",y+1)]] == 0) {
        "Enter both numbers"} else{
          paste0("Average = ",round(Avg()[[(y/2)+.5]],1))}
    })
  })
  # Enable/Disable Submit button if average is not 0, and below 5
    observe({
      lapply(seq(1,3,2),function(y){
      req(input[[paste0("Number_",y)]], input[[paste0("Number_",y+1)]])
      if(Avg()[[1]] > 0 & Avg()[[1]] <= 5 | Avg()[[2]] > 0 & Avg()[[2]] <= 5 ) {
        shinyjs::enable(paste0("Complete_"))} else{shinyjs::disable(paste0("Complete_"))}
    })
  })
  #Show next average box if average is not below 5
    observe({
      lapply(seq(1,3,2),function(y){
      req(input[[paste0("Number_",y)]],input[[paste0("Number_",y+1)]])
      if(y == 1 & Avg()[[(y/2)+.5]] <= 5) {
        shinyjs::show(paste0("Box_ID_","_",1))
        shinyjs::hide(paste0("Box_ID_","_",3))
      } else if(y == 1 & Avg()[[(y/2)+.5]] > 5) {
        shinyjs::show(paste0("Box_ID_","_",1))
        shinyjs::show(paste0("Box_ID_","_",3))
      } else if(Avg()[[(y/2)+.5]] > 5) {
        shinyjs::show(paste0("Box_ID_","_",y+2))
      } else {shinyjs::hide(paste0("Box_ID_","_",y+2))}
    })
  })
  #Submit Button - Reset boxes, print memory######
  observeEvent(input[[paste0("Complete_")]],{
    #Reset the page
    reset(paste0("BOX_"))
    #Garabage collect
  })
  #Memory used############
  observeEvent(input[[paste0("Complete_")]],{
    output[[paste0("Memory")]]<-renderText({
      paste0(round(mem_used()/1000000,3)," mb")
    })
  })
}
# Run App
shinyApp(ui, server)

My best guess is the leak is from the observe/observe events.I have tried the reactlog described here: https://github.com/rstudio/shiny/issues/1591 But I'm not exactly figuring that what the issue is there. I also looked into this, but I'm not using any outputs in observe: https://github.com/rstudio/shiny/issues/1551 I had written earlier asking for ideas on how to find memory leaks: R Shiny Memory Leak - Suggestions on how to find? From that I'm still looking into modules a bit to see if that will help.

Thank you for any help.