Search code examples
rshinyr-leaflet

shiny leaflet - extent of downloaded map


I have an app with a map that is being downloaded. I'm stumped as to why the spatial extent / zoom of the downloaded image is so different from what is being displayed on the screen. Looking for any suggestions to make the output match as close as possible the map displayed in the app itself...

library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)

# reproducible example of the shiny app
df <- structure(list(Lon = c(-111.584650079555, -112.17670350598, -111.585725614472, -112.173232931394, -111.772792415394), Lat = c(41.7797872701221, 43.0098749960118, 41.7489995541869, 43.0096673539034, 42.1053681392244), Size = c(1:5)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame"))

server = function(input, output){

    mymap <- reactive({
      leaflet(df) %>%
        setView(lng = -111.6, lat = 41.8, zoom = 8) %>%
        addProviderTiles("Esri.WorldImagery", layerId = "basetile",
            options = providerTileOptions(minZoom = 8, opacity = 0.75)) })

    output$map <- renderLeaflet({
      mymap() })

    myfun <- function(map, df.in){
      addCircleMarkers(map, data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 4, color = "red")  
                                            }                           
    observe({
      leafletProxy("map") %>% myfun(df)
    })
    
    # map that will be downloaded
    mapdown <- reactive({
     mymap() %>% myfun(df) 
    })
                        
    output$map_down <- downloadHandler(
      filename = 'mymap.png',

      content = function(file) {
        owd <- setwd(tempdir())
        on.exit(setwd(owd))
        mapshot(mapdown(), file = file, cliprect = "viewport")
                        })}

ui <- fluidPage(
     sidebarPanel(downloadButton('map_down', "Download map")), 
     mainPanel(leafletOutput("map")))

shinyApp(ui = ui, server = server)

EDIT

Following @HubertL's advice, I spent a looooong time defining and redefining the viewport size (as well as the clipping options), and trying this and that, until I finally figured out that the issue I'm actually only happens with myfun (the function that actually makes the plot) includes fitBounds, which I need for the user to be able to export the figure after zooming in. So - I'm updating the question, with code that shows that the clipping proposed in the answer works perfectly, unless the fitBounds() are included. How do I export a map following user zooming?

library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)

df <- structure(list(Lon = c(-105.618, -105.505, -105.671, -105.737, -105.318, -105.747, -105.693, -105.126, -104.975, -105.297), Lat = c(23.851, 23.646, 24.085, 24.063, 23.378, 24.253, 23.965, 23.153, 23.127, 23.33), Size = c(4, 1, 4, 4, 2, 3, 4, 1, 1, 3)), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
            
ui <- navbarPage("My app", id = "nav", 
      fluidRow(column(width = 8, 
        leafletOutput("map", height = "800px")),
        column(width = 4, 
            downloadButton('ExportMap', label = "Download the map"))))          

myfun <- function(map, df.in, bounds){
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)
        
    clearShapes(map) %>%
        clearMarkers() %>%
        clearControls() %>%
        addCircleMarkers(data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 3) %>%
        ## This is the culprit - export works well if this is commented out
    #   fitBounds(min(lngRng), min(latRng), max(lngRng), max(latRng)) 
                              }
                                                                
server <- function(input, output, session){
    mymap <- reactive({
      leaflet(df, options = leafletOptions(
            attributionControl=FALSE)) %>%
        setView(lng = -105.5, lat = 23.7, zoom = 8) %>%
        addProviderTiles("Esri.WorldImagery", layerId = "basetile",
            options = providerTileOptions(minZoom = 7, opacity = 0.75))
                                }) 
    
    output$map <- renderLeaflet({
        mymap()
                                }) 
                                
bounds.calc <- reactive({
            bounds <- input$map_bounds
            zoom <- input$map_zoom
            cen <- input$map_center
            
            output <- list(bounds = bounds, zoom = zoom, center = cen)
                    })
                    
observe({
        leafletProxy("map") %>% myfun(df, bounds = bounds.calc()$bounds)        
                                    }) 

# map that will be downloaded
  mapdown <- reactive({
    mymap() %>% myfun(df, bounds = bounds.calc()$bounds) 
  })
  
output$ExportMap <- downloadHandler(
      filename = 'mymap.png',

      content = function(file) {
        owd <- setwd(tempdir())
        on.exit(setwd(owd))
        mapshot(mapdown(), file = file, cliprect = "viewport", vwidth= 800, vheight = 600)
                        })}

shinyApp(ui = ui, server = server)

Solution

  • You can set the vheight and vwidth parameters for webshot() :

    mapshot(mapdown(), file = file, cliprect = "viewport", vwidth= 600, vheight = 400)