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)
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)
You can set the vheight
and vwidth
parameters for webshot()
:
mapshot(mapdown(), file = file, cliprect = "viewport", vwidth= 600, vheight = 400)