Launch a Shiny app with your `ggplot2` object, zoom control added: `gg_zoom(g)`

readme.md

motivation

I often found I want to zoom in a ggplot2 plot interactively.

• There is svgPanZoom but that is just like zoom in on a static picture, you will not see additional details.
• There is ggplot2 extension mechanism. But I don't want to add more geom functions. I want to take any ggplot2 you just made and add zoom control to it.

usage

Now you can create your plot and feed it to one function, then a Shiny app will be launched with your plot. Use mouse to draw a box, then double click to zoom in. Double click anywhere to reset the zoom.

source("gg_zoom.R")

x <- 1:1000
y <- runif(length(x), 0,10)
df <- data.frame(x = x, y = y)
g <- ggplot(df, aes(x,y)) +
  geom_point()

gg_zoom_m(g)

# it will detect the axis type of date/date time and apply conversion function needed automatically. This need the lubridate package.
x <- seq(as_date("2000/01/01"), as_date("2000/06/01"), by = "day")
y <- runif(length(x), 0,10)
df <- data.frame(x = x, y = y)
g <- ggplot(df, aes(x,y)) +
  geom_point()
gg_zoom(g)

x <- seq(ymd_hms("2000/01/01 00:00:01"), ymd_hms("2000/02/01 11:59:59"), by = "hour")
y <- runif(length(x), 0,10)
df <- data.frame(x = x, y = y)
g <- ggplot(df, aes(x,y)) +
  geom_point()
gg_zoom(g)

I tried ggplot() %>% gg_zoom() but that doesn't work, so you still need to save the ggplot object first.

limit on axis override

Because of the implementation, it's possible that the zoom may override the fixed aspect ratio or xlim/ylim specified in original plot.

gg_zoom.R

# Launch a Shiny app with your ggplot object, zoom control added: gg_zoom(g)
# Shiny brush event always return numerical values for the zoom box. If the x or y axis is in date, date-time, the zoom box coordinates need to be converted before taken by ggplot.
# https://github.com/hadley/scales/blob/38f81a7b79d98c06edd7d0b624c77b7834db508f/R/trans-date.r
# this will convert date, datetime axes automatically, though it need lubridate to work because the base R equivalent are more cumbersome to use.

library(shiny)
library(ggplot2)
library(lubridate)

ui <- fluidPage(
  plotOutput("plot",
    dblclick = "plot_dblclick",
    brush = brushOpts(
      id = "plot_brush",
      resetOnNew = TRUE
    ))
)
server_with_g <- function(g) {
  gb <- ggplot_build(g)
  x_scale <- gb$layout$panel_scales$x[[1]]$scale_name
  y_scale <- gb$layout$panel_scales$y[[1]]$scale_name
  get_trans_fun <- function(axis_scale) {
    switch(axis_scale,
      date = as_date,
      datetime = as_datetime,
      identity)
  }
  x_as <- get_trans_fun(x_scale)
  y_as <- get_trans_fun(y_scale)
  server <- function(input, output){
    add_zoom <- function(plot_id) {
      ranges <- reactiveValues(x = NULL, y = NULL)
      observeEvent(input[[paste0(plot_id, "_dblclick")]], {
        brush <- input[[paste0(plot_id, "_brush")]]
        if (!is.null(brush)) {
          # ranges$x <- c(brush$xmin, brush$xmax)
          ranges$x <- x_as(c(brush$xmin, brush$xmax))
          ranges$y <- y_as(c(brush$ymin, brush$ymax))
        } else {
          ranges$x <- NULL
          ranges$y <- NULL
        }
      })
      ranges
    }
    plot_range <- add_zoom("plot")
    output$plot <- renderPlot({
      g +
        coord_cartesian(xlim = plot_range$x, ylim = plot_range$y)
    })
  }
}

gg_zoom <- function(g) {
  shinyApp(ui = ui, server = server_with_g(g))
}