Leaflet dynamic tiles

addDynamicTiles.R

library(shiny)
library(leaflet)

#' Add a tile layer whose source is an R function
#'
#' @param tileFunc A function(x, y, z) that returns a 256x256 image object
#'   suitable for passing to `png::writePNG`.
#' @seealso [leaflet::addTiles()] for other parameters
addDynamicTiles <- function(map, tileFunc,
  layerId = paste0("leafletRaster", sample.int(9999999, 1)),
  attribution = NULL, group = NULL, options = tileOptions()) {
  
  session <- shiny::getDefaultReactiveDomain()
  if (is.null(session)) {
    stop("leaflet::addDynamicTiles only works in a live Shiny session")
  }
  
  # We can use registerDataObj to add a new HTTP handler at a URL of Shiny's
  # choosing. In this case we expect requests for Slippy tiles, with URL
  # params z, x, and y; our job is to return image/png data.
  url <- session$registerDataObj(
    # The layer ID indicates the "slot" in the current Shiny session that our
    # data object will occupy. This can be any simple identifier and has not
    # much consequence except to garbage collect the previous value of layerId
    # each time a new one is registered.
    layerId,
    list(), # The object itself
    function(data, req) {
      tile <- shiny::parseQueryString(req$QUERY_STRING) %>% lapply(as.integer)
      
      tileResult <- tileFunc(x = tile$x, y = tile$y, z = tile$z)

      pngData <- png::writePNG(tileResult)
      return(list(
        status = 200L,
        headers = list("Content-Type" = "image/png"),
        body = pngData
      ))
    }
  )
  
  urlTemplate <- paste0(url, "&z={z}&x={x}&y={y}")
  
  leaflet::addTiles(map, urlTemplate = urlTemplate,
    attribution = attribution, layerId = layerId,
    group = group, options = options)
}


# Begin example

ui <- fillPage(
  leafletOutput("map", height = "100%")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addDynamicTiles(function(x, y, z) {
        # Return 256x256 image data, suitable for passing to png::writePNG
        png::readPNG(system.file("img","Rlogo.png",package="png"), TRUE)
      })
  })
}

shinyApp(ui, server)