Skip to content

mapview::mapshot output png file image does not match the leaflet image in app.R #487

Open
@ptepa

Description

@ptepa

# app.R - How to save a leaflet map as a png with the correct view?
# To run:
# R -e "shiny::runApp('../map', launch.browser = TRUE)"
# Click Save Map Image button and wait until the printed message 'Done'.
# Mac: open map.png
# Windows: start map.png
# Check that the map.png image matches that displayed in this app.
# The file unmatched.png shows that the map image displayed does not match the
# map image in the saved map.png file.
# For example the saved map.png file appears zoomed-out more and shows Boston
# whereas the map displayed in the app does not show that extended view.
# MacOS 10.13.6, R 4.2.1, shiny 1.7.4, leaflet 2.1.1, mapview 2.11.0,
# webshot 0.5.4
# Darwin.zip contains subdirectory Darwin.x86_64/bin/pandoc,phantomjs
# Windows.zip contains subdirectoryWindows/bin/pandoc.exe,phantomjs.exe

repository <- "http://cran.us.r-project.org"

if (!require(shiny)) install.packages("shiny", repos = repository)
if (!require(leaflet)) install.packages("leaflet", repos = repository)
if (!require(mapview)) install.packages("mapview", repos = repository)
if (!require(webshot)) install.packages("webshot", repos = repository)

the_map_width = "496px"
the_map_height = "372px"
#the_map_width = "512px"
#the_map_height = "512px"

ui <- fluidPage(
  leafletOutput(outputId = "map",
                width = the_map_width,
                height = the_map_height),
  actionButton(inputId = "save_map_image", label = "Save Map Image")
)

server <- function(input, output, session) {

  # Add platform-specific bin sub-directory to PATH for pandoc and phantomjs
  # programs that are apparently called by mapview::mapshot(). UGLY.

  augment_path <- function() {
    current_path <- Sys.getenv("PATH")
    current_directory <- getwd()
    platform <- Sys.info()[["sysname"]]

    if (platform != "Windows") {
      platform <- paste0(platform, ".", Sys.info()[["machine"]])
    }

    new_path <- NULL

    if (platform == "Windows") {
      new_path <- paste0(current_path, ";", current_directory, "\\Windows\\bin")
    } else {
      new_path <-
        paste0(current_path, ":", current_directory, "/", platform, "/bin")

      # Also ensure the executables are executable:

      chmod_command <- paste0("chmod -R +x ", platform)
      system(chmod_command)
    }

    Sys.setenv(PATH = new_path)
  }

  augment_path()
  print(Sys.getenv("PATH"))

  create_map <- function() {
    # Starting view is New York:
    west <- -74.36371
    east <- -71.6391
    south <- 40.68272
    north <- 42.21428
    result <- leaflet() %>%
      addTiles(options = list(minZoom = 2)) %>%
      fitBounds(west, south, east, north) %>%
      setMaxBounds(-180.0, -90.0, 180.0, 90.0) %>%
      addScaleBar(position = "topleft", options = list(imperial = FALSE))
    return(result)
  }

  the_map <- create_map()
  output$map <- renderLeaflet(the_map)

  observeEvent(input$save_map_image, {
    # How to get the_map current bounds and zoom level and pass it to mapshot()?
    cat("the_map = "); str(the_map)
    cat("input$map = "); str(input$map)
    cat("input$map_bounds = "); str(input$map_bounds) # This works.
    cat("input$map_zoom = "); str(input$map_zoom)
    cat("input$map_center$lng = "); str(input$map_center$lng)
    cat("input$map_center$lat = "); str(input$map_center$lat)
    the_map_zoom <- input$map_zoom
    file_name <- paste0(getwd(), "/map.png")
    #mapview::mapshot(the_map, file = file_name,
    #                 vwidth = the_map_width, vheight = the_map_height)
    # https://github.com/r-spatial/mapview/issues/414
    mapview::mapshot(the_map %>%
                     setView(lng = input$map_center$lng,
                             lat = input$map_center$lat,
                             zoom = input$map_zoom),
                     file = file_name,
                     vwidth = the_map_width,
                     #vheight = the_map_height,
                     wheight = the_map_height,
                     expand = 0, cliprect = "viewport", selfcontained = FALSE)
    cat("Done writing ", file_name, "\n")
  })

  # Callback for map pan/zoom events.
  # Check and adjust map bounds to stay within 'non-replicated view'
  # (that does not cross the +/-180 line):

  observeEvent(input$map_bounds, {
    bounds_list <- input$map_bounds
    west <- bounds_list$west
    east <- bounds_list$east
    south <- bounds_list$south
    north <- bounds_list$north

    if (west == east) east <- west + 1.0
    if (south == north) north <- south + 1.0

    if (west <= -180.0) west <- -179.0
    if (east >= 180.0) east <- 179.0
    if (south <= -90.0) south <- -89.0
    if (north >= 90.0) north <- 89.0

    the_map <<- fitBounds(the_map, west, south, east, north)
    cat("input$map_center$lng = "); str(input$map_center$lng)
    cat("input$map_center$lat = "); str(input$map_center$lat)
    cat("input$map_bounds = "); str(input$map_bounds) # This works.
    cat("input$map_zoom = "); str(input$map_zoom)
  })

}

shinyApp(ui, server)

unmatched

Darwin.zip
Windows.zip

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions