Zoom/pan with adaptive resolution in Shiny

Question

I have a Shiny app where I need to be able to seamlessly pan/zoom very large microscopy images (300+ MB). Is there an existing Shiny solution (or JavaScript if not) that allows for loading a low-resolution image initially and then higher resolution tiles as needed? I also need to overlay interactive elements on the image.

Answer 1

You could use library(leaflet) along with custom images.

Regarding the adaptive resolution you'll have to deal with leaflet's zoom levels.

As a first apporach, the following is a modified version of this answer displaying a local image in a leaflet widget:

library(shiny)
library(ggplot2)
library(datasets) # mtcars for dummy image
library(leaflet)
library(imager)

if(!dir.exists("myimages")){
  dir.create("myimages")
}

img_path <- "myimages/plot.png"
fig <- ggplot(mtcars) + geom_point(aes(mpg, disp, colour = hp))
ggsave(filename = img_path, plot = fig, width = 4000, height = 3000, units = "px")

ui <- fluidPage(leafletOutput("mymap", height = "92vh"))

server = function(input, output, session) {
  
  # Add directory of static resources to Shiny's web server - www folder can be used instead
  addResourcePath(prefix = "imgresources", directoryPath = "myimages")

  img_data <- load.image(img_path)
  img_ratio <- height(img_data) / width(img_data)
  img_ratio_bound <- 180 / 2 * img_ratio

output$mymap <- renderLeaflet({
  m <- leaflet(options = leafletOptions(zoomSnap = 0.01, zoomDelta = 0.01)) %>%
    htmlwidgets::onRender(
      sprintf("
                function(el, x) {
                  var map = this;
                  var imageUrl = '%s';
                  var imageBounds = [[-180, -180], [%s, 180]];
                  L.imageOverlay(imageUrl, imageBounds).addTo(map);
                  map.fitBounds(imageBounds);
                }
                ", "imgresources/plot.png", img_ratio_bound)
    )
  m
  })
}

shinyApp(ui, server)

---

An alternative solution could be using library(plotly). Please check this example (Edit: added a copy of the plotly example):

library(plotly) 

#Constants 
img_width = 1600 
img_height = 900 
scale_factor = 0.5 


# Add invisible scatter trace. 
# This trace is added to help the autoresize logic work. 
fig <- plot_ly(width=img_width * scale_factor, 
               height=img_height * scale_factor 
) %>% 
  add_trace( x= c(0, img_width * scale_factor), 
             y= c(0, img_height * scale_factor), 
             type = 'scatter',  mode = 'markers', alpha = 0) 

# Configure axes 
xconfig <- list( 
  title = "", 
  zeroline = FALSE, 
  showline = FALSE, 
  showticklabels = FALSE, 
  showgrid = FALSE, 
  range = c(0, img_width * scale_factor) 
) 

yconfig <- list( 
  title = "", 
  zeroline = FALSE, 
  showline = FALSE, 
  showticklabels = FALSE, 
  showgrid = FALSE, 
  range = c(0, img_height * scale_factor), 
  scaleanchor="x" 
) 

fig <- fig %>% layout(xaxis = xconfig, yaxis = yconfig) 

# Add image 

fig <- fig %>% layout( 
  images = list(  
    list(  
      source =  "https://raw.githubusercontent.com/michaelbabyn/plot_data/master/bridge.jpg",  
      x=0, 
      sizex=img_width * scale_factor, 
      y=img_height * scale_factor, 
      sizey=img_height * scale_factor, 
      xref="x", 
      yref="y", 
      opacity=1.0, 
      layer="below", 
      sizing="stretch" 
    )  
  )) 

# Configure other layout 

m = list(r=0, l=0, b=0, t=0) 
fig <- fig %>% layout(margin = m) %>%
  layout(plot_bgcolor='#e5ecf6',  
          xaxis = list(  
            zerolinecolor = '#ffff',  
            zerolinewidth = 2,  
            gridcolor = 'ffff'),  
          yaxis = list(  
            zerolinecolor = '#ffff',  
            zerolinewidth = 2,  
            gridcolor = 'ffff')  
          )
fig