R Shiny: create non-reactive background in plotOutput

Question

I'm trying to build a shiny app where I can change a plot interactively. I want the plot to change within miliseconds and as the changes only include the addition of some points this is actually possible.

The reproducible example contains an abstraction of this idea. The first example plots a scatterplot and I can interactively change the number of points. This happens basically immediately. I'll refer to this part of the plot as the "reactive layer".

library(shiny)

ui <- fluidPage(
  
  sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
  plotOutput(outputId = "plotx")
  
)

quick_server <- function(input, output, session){
    
  output$plotx <- renderPlot({
    
    # reactive layer
    plot(
      x = sample(x = -4:4, size = input$slider_input, replace = T), 
      y = sample(x = -4:4, size = input$slider_input, replace = T)
      )
    
  })
  
}

shinyApp(ui = ui, server = quick_server)

The problem is that the plot that I want to change interactively always includes a "slow non reactive layer" of many datapoints that are unreactive and never change. Due to the size of this data set and renderPlot() always replotting it the speed with which I interactively change the "reactive layer" decreases dramatically.

library(shiny)

ui <- fluidPage(
  
  sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
  plotOutput(outputId = "plotx")
  
)

slow_server <- function(input, output, session){
  
  base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
  
  output$plotx <- renderPlot({
    
    # slow non reactive layer
    plot(x = base_data()$x, y = base_data()$y)
    
    # reactive layer
    points(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T), 
      col = "red", 
      cex = 5, 
      pch = 19
      )
    
  })
  
}

shinyApp(ui = ui, server = slow_server)

As the base data and the resulting plot (here a cloud of points) never changes it is quite annyoing that renderPlot() always replots everything (both "layers"). Is there a way to "isolate" the plot created from the non reactive data set? Such that the layer that is not reactive is not replotted?

I have already tried to work with ggplot2 and create a steady layer

big_data_frame <- data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000))

steady_layer <- reactiveVal(value = geom_point(data = big_data_frame, mapping = aes(x = x, y = y))

And then created the plot like this

output$plotx <- renderPlot({

  small_df <- 
   data.frame(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T)
    )
  
   ggplot() + 
    steady_layer() +
    geom_point(data = small_df, mapping = aes(x = x, y = y) 
    
})

But this doesn't help as it is the replotting process that takes time not creating the ggplot layer itself.

Although I can imagine that the solution might be to create a .png of the big plot and use it as the background of the HTML and CSS for the output$plotx by making it a reactive UI I have not managed to manipulate the HTML and CSS successfully.

Any help is appreciated. Thanks so much in advance!

Answer 1

You need to understand how renderPlot works. It uses the R png function first to create a png and then sends it to the client browser. When the data of the plot changes, this png is recreated. So, replot part of the png is not possible. So adding points to an existing plot will always use the time of slow points + new points, so under the current shiny mechanism, it is not possible not to recalculate these slow points. A possible option is to use plotly with proxy . It is made of HTML and Javascript, so yes, you can do it with partial updating. See the link for details, not repeating here. For my personal experience, it is fast not so fast as milliseconds-level as you want.

So here I have a smart trick for you: why do we update on the same plot? We can use one plot as background and it is slow, but we only render it one time, and we will never touch it again. Then we update another plot that has only a few points and we stack this plot on top of the slow plot.

Here is how:

1. add some CSS tricks to do the stacking
2. rendering the slow plot
3. rendering the the quick plot with transparency

library(shiny)
library(ggplot2)
ui <- fluidPage(
    
    sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
    div(
        class = "large-plot",
        plotOutput(outputId = "plot_bg"),
        plotOutput(outputId = "plotx")
    ),
    tags$style(
        "
        .large-plot {
            position: relative;
        }
        #plot_bg {
            position: absolute;
        }        
        #plotx {
            position: absolute;
        }
        "
    )
    
    
)

slow_server <- function(input, output, session){
    
    base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
    
    output$plot_bg <- renderPlot({
        ggplot(base_data()) +
            geom_point(aes(x,y)) +
            scale_x_continuous(breaks = -4:4) +
            scale_y_continuous(breaks = -4:4) +
            xlim(-5, 5) +
            ylim(-5, 5)
    })
    output$plotx <- renderPlot({
        data.frame(
            x = sample(x = -4:4, size = input$slider_input, replace = T),
            y = sample(x = -4:4, size = input$slider_input, replace = T)
        ) %>% 
            ggplot() +
                geom_point(aes(x,y), color = "red", size = 3) + 
                scale_x_continuous(breaks = -4:4) +
                scale_y_continuous(breaks = -4:4) +
            theme(
                panel.background = element_rect(fill = "transparent"),
                plot.background = element_rect(fill = "transparent", color = NA), 
                panel.grid.major = element_blank(), 
                panel.grid.minor = element_blank(), 
                legend.background = element_rect(fill = "transparent"), 
                legend.box.background = element_rect(fill = "transparent")
            )+
            xlim(-5, 5) +
            ylim(-5, 5)
    }, bg="transparent")
    
}

shinyApp(ui = ui, server = slow_server)