How to highlight points on a ggplot with facet in shiny without reloading all?

Question

I would like to dynamically and rapidly highlight points on a faceted ggplot in shiny.

My problem: the graphic takes quite a lot of time to be recomputed each time (It often happens to me with facet plots).

Ideas At this moment I have only two:

1. Find a way to “precalculate” once for all the original ggplot, and only modify some points in red.
2. Find a way to perfectly overlay the original ggplot with a ggplot limited to red points (which will be much lighter).

References: I found these topics:

• Overlaying two graphs using ggplot2 in R
• Update large plots in Shiny without Re-Rendering

but it doesn’t seem to apply to my issue. Please find below a reproducible example. Thank you very much for your help and support!

library(shiny); library(ggplot2); library(dplyr)
# Dataset
data_=do.call("rbind", replicate(1000, mtcars, simplify = FALSE))
# General graphic
p_0=ggplot(data=data_,aes(x=wt,y=mpg))+geom_point()+facet_wrap(~carb)

VERSION 1: Easy reading code but an important lag effect when updating the data

ui=fluidPage(
                fluidRow(
                    column(width = 12,
                    numericInput("choice", "Highlight in red when carb=",1,),
                    plotOutput("plot1"))
                )
                )

server=function(input, output) {
    p=reactive({return(
        p_0+geom_point(data=data_ %>% filter(carb==input$choice),aes(x=wt,y=mpg),color='red')
        )})
    output$plot1=renderPlot({p()})
}

shinyApp(ui, server)

VERSION 2: Better user experience but difficult reading code, difficult layout using absolute panel, and still a lag issue

ui=fluidPage(
    fluidRow(
        column(width = 12,
            numericInput("choice", "Highlight in red when carb=", 1,),
            absolutePanel(plotOutput("plot1"), top = 200, left = 0,width = 500, height = 500),
            absolutePanel(plotOutput("plot2"), top = 200, left = 0,width = 500, height = 500)
        )
    )
    )

server=function(input, output) {

    p=reactive({return(ggplot(data=data_,aes(x=wt,y=mpg))+geom_blank()+facet_wrap(~carb)+
        geom_point(data=data_ %>% filter(carb==input$choice),color='red',size=3)+
        theme_bw()+
        theme(legend.position="none")+
        theme(
          panel.background =element_rect(fill = "transparent"),
          plot.background = element_rect(fill = "transparent"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
        )
        )})
    output$plot1=renderPlot({p_0},bg="transparent")
    output$plot2=renderPlot({p()},bg="transparent")

}

shinyApp(ui, server)

Answer 1

I think I've squeezed a small speed improvement by doing the following two things:

• Changed the numeric input into a select input box with restricted choices.
• Simplified the code to make only the colour palette into a reactive expression.

library(shiny); library(ggplot2); library(dplyr)
# Dataset
data_=do.call("rbind", replicate(1000, mtcars, simplify = FALSE))
# General graphic

ui=fluidPage(
  fluidRow(
    column(width = 12,
           selectInput("choice", "Highlight in red when carb=",1, choices = c(1:4,6,8)),
           plotOutput("plot1"))
  )
)

server=function(input, output) {

  cols <- reactive({
    cols <- c("1" = "black", "2" =  "black", "3" =  "black",
              "4" =  "black", "6" =   "black",   "8" =   "black")
    cols[input$choice] <- "red"
    return(cols)
  })

  output$plot1=renderPlot({
    ggplot(data_, aes(x=wt, y=mpg, color = as.character(carb))) +
      geom_point() +
      scale_colour_manual(values = cols()) +
      facet_wrap(~carb)
      })
}

shinyApp(ui, server)