Skip to content

Instantly share code, notes, and snippets.

@dracodoc
Last active November 22, 2023 21:02
Show Gist options
  • Save dracodoc/d231fb467cd31f4c6956cf5acba025ec to your computer and use it in GitHub Desktop.
Save dracodoc/d231fb467cd31f4c6956cf5acba025ec to your computer and use it in GitHub Desktop.
Launch a Shiny app with your `ggplot2` object, zoom control added: `gg_zoom(g)`

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.

# 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))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment