Redrawing multiple highcharts / possible memory leak?

[tvi-tzvi]

Hello again! I posted my question in the original thread issue 37. But since it is marked as closed I think that it is not the worst idea to open a new issue. Please find my original post below.

Hi there! I know that it might be an old topic, but I recently faced some issues regarding the code posted above. Consider an example with the code above, where it is used in a loop and plots are redrawn lets say every second. In such case I noticed a claiming memory usage in Chorme Task-manager what after a period of time leads to "Aw Snap something went wrong while displaying this web page". For a minimal example I didn't change much of the code just included invalidateLater into the renderUI function.

library("shiny")

library("highcharter")

ui <- fluidPage(
  selectInput("nplots", "Choose", multiple = TRUE, width = "100%",
              choices = c("cars", "mtcars", "iris",
                          "Puromycin", "ChickWeight")),
  fluidRow(
    column(12, htmlOutput("hcontainer")),
    highchartOutput("hcontainer2", height = "0", width = "0")
    # the previous output is hide. This is needed load highcharts/highcharter
    # javascript in the app
  )
)

server <- function(input, output) {

  gethc <- function(dfname = "cars") {
    # function to return the chart in a column div
    df <- get(dfname)

    hc <- highchart(height = 300) %>% 
      hc_title(text = dfname) %>% 
      hc_xAxis(title = list(text = names(df)[1])) %>% 
      hc_yAxis(title = list(text = names(df)[2])) %>% 
      hc_add_series_scatter(df[,1], df[, 2]) %>% 
      hc_add_theme(
        list(hc_theme_538(), hc_theme_economist(), hc_theme_darkunica())[sample(1:3, size = 1)][[1]]
      )

    column(width = 6, hc)

  }

  output$hcontainer <- renderUI({
    invalidateLater(1000)
     input <- list(nplots =  c("cars", "mtcars", "iris",
                               "Puromycin", "ChickWeight"))
    charts <- lapply(input$nplots, gethc)
    do.call(tagList, charts)

  })  

}

shinyApp(ui = ui, server = server)

Please Let me know if you are able to replicate the issue and off course have suggestions how to get rid of this nasty problem. Greetings!

[jbkunst]

Hi @TJ66

I used:

    invalidateLater(1000)
   #  input <- list(nplots =  c("cars", "mtcars", "iris",
   #                           "Puromycin", "ChickWeight"))
    charts <- lapply(input$nplots, gethc)
    do.call(tagList, charts)

and it worked. Maybe using a sensible variable name (input) can cause issues (in my case). Did you solve this? I'm don't have clue about this at the moment.

[tvi-tzvi]

Hi, @jbkunst! Thanks for your quick answer! Maybe i wasn't specific enough. The code works fine and I am able to draw highcharts. The problem is, as I understand, that after the redraws some of the old and irrelevant highcharts aint captured by the garbage collector. So after sufficient amount of iterations the memory limit is reached and it causes already mentioned "Aw snap" problem. To speed up the issue you can use larger datasets for larger highcharts.

Please find a screenshot of chrome Timeline. As you can see the memory usage is increasing over the time.(In this example i used 10.000 ms for invalidatelater.)

Greetings!

P.S. on my own I am a bit fishing in the dark and thinking about JS to clear hcontainer, but there wasn't much of successes at least yet..

[jbkunst]

Now I see... Did you test with other htmlwidgets/browser?

[tvi-tzvi]

I haven't tried other html widgets, but the issue with this/similar code is also seen on windows machines with FF and IE.

[tvi-tzvi]

Hello again! I had some time to play around with this issue. I did the following: Before each redraw I decided to send a message and use javascript to destroy highcharts. Please, find the code below.( I apologize for posting the whole code, but I think it is easier this way just to copy/paste and run it).

library("shiny")
library("highcharter")
rm(list=ls())
ui <- fluidPage(
  tags$head(tags$script(HTML("
                             $( document ).ready(function() {
                             Shiny.addCustomMessageHandler(\"destroy\",
                             function(message) {
                             var cont = document.getElementById(message.destroy);
                             var plots= cont.getElementsByClassName('highchart');
                             for (var i = 0; i < plots.length; i++) {
                                 $('#'+plots[i].id).highcharts().destroy();
                                 $('#'+plots[i].id).empty();
                                 Shiny.bindAll(cont);
                             }
                             }
                             );
                             });
                             ")))
  ,
  selectInput("nplots", "Choose", multiple = TRUE, width = "100%",
              choices = c("cars", "mtcars", "iris",
                          "Puromycin", "ChickWeight")),
  fluidRow(
    column(12, htmlOutput("hcontainer")),
    highchartOutput("hcontainer2", height = "0", width = "0")
    # the previous output is hide. This is needed load highcharts/highcharter
    # javascript in the app
  )
  )

server <- function(input, output,session) {

  gethc <- function(dfname = "cars") {
    # function to return the chart in a column div
    df <- get(dfname)

    hc <- highchart(height = 300) %>%
      hc_title(text = dfname) %>%
      hc_xAxis(title = list(text = names(df)[1])) %>%
      hc_yAxis(title = list(text = names(df)[2])) %>%
      hc_add_series_scatter(df[,1], df[, 2]) %>%
      hc_add_theme(
        list(hc_theme_538(), hc_theme_economist(), hc_theme_darkunica())[sample(1:3, size = 1)][[1]]
      )

    column(width = 6, hc)

  }

  output$hcontainer <- renderUI({
    invalidateLater(10000)
    #Sys.sleep(5)
    #browser()
    session$sendCustomMessage(type = "destroy", message=list(destroy="hcontainer"))
    input1 <- list(nplots =  c("cars",
                               "mtcars", "iris","Puromycin", "ChickWeight"))
    charts <- lapply(input1$nplots, gethc)
    do.call(tagList, charts)
  })

}

shinyApp(ui = ui, server = server)

The screen shot of Timeline can be found below.

Greetings!

[jbkunst]

Nice! I guess we can close the issue :D. I think take some time but I guess is due to the many dom elements in higcharts containers.