Adding Leaflet Map including LeafletProxy in R Markdown download in Shiny App

Question

I'm attempting to create a Shiny app which includes a map, and a downloadable Markdown report which has a copy of that map. I'm using the mapshot package, since it has the option to remove the zoom controls from the screenshot. However, I'm having difficulty with accessing the map inside the downloadHandler. I've tried leaflet('map') and leafletProxy('map'), but both of these either return errors or blank images. How can I fix the below code so that the map in the state it is in when the user clicks the button is inserted into the markdown document?

Reproducible example with some random sample data below:

library(shiny)
library(leaflet)
library(rmarkdown)
library(mapview)
library(sf)

locations <- data.frame(
  name = c("Location A", "Location B", "Location C", 
           "Location D", "Location E", "Location F", "Location G"),
  lat = c(-27.4698, -27.9997, -27.4533, -27.4743, -27.4699, -27.3846, -27.4495),
  lon = c(153.0251, 153.0147, 153.0350, 153.0282, 153.0157, 153.1173, 153.0336)
) 

locations_sf <- st_as_sf(locations, coords = c("lon", "lat"), crs = 4326)

locations_picker <- sort(locations$name)

ui <- fluidPage(

  pickerInput(
    inputId = "location_picker",
    label = "Select a location",
    choices = locations_picker
  ),

  leafletOutput("map"),

  downloadButton(outputId = "download_button", label = "Download report")
)

server <- function(input, output) {
  
  # Create reactive value with initial boolean
  selected_location <- reactiveVal(FALSE)

  # Create the initial map object  
  map_object <- leaflet(
    options = leafletOptions(
      attributionControl = FALSE
      )
    ) %>%
    addProviderTiles(providers$Esri.WorldGrayCanvas)

  # Render the initial map
  output$map <- renderLeaflet(
    map_object
  )

  # Update the reactive value with the selected location
  observe({
    selected_location(input$location_picker)
  }) %>%
    bindEvent(input$location_picker)

  observe({
    # Filter the locations data for the selected location
    selected_location_data <- locations_sf %>%
      filter(name == selected_location())

    leafletProxy("map") %>%
      # Zoom to location
      setView(
        lng = 
                st_coordinates(selected_location_data)[1], 
              lat = st_coordinates(selected_location_data)[2], 
        zoom = 20) %>%
      clearMarkers() %>%
      addMarkers(
        data = selected_location_data,
        label = paste0(
          "<strong>Locality:</strong>", selected_location_data$name, "<p>"
        ) %>% htmltools::HTML()
      )
  }) %>%
    bindEvent(selected_location())

  output$download_button <- downloadHandler(
    filename = function() {
      paste0("Report for ", selected_location(), ".html")
    },
    content = function(file) {
      # Create a temporary directory for the map image
      temp_dir <- tempdir()

       mapshot2(leafletProxy("map"), file = file.path(temp_dir, "map.png"))

      rmd_content <- glue("

      ---
      title: 'Report for {selected_location()}'
      output: html_document
      ---

      ## Leaflet map
      ![Map](file.path(temp_dir, 'map.png'))

      This is an example markdown.
      ")

      # Write the content to a temporary file
      rmd_file <- file.path(temp_dir, "report.Rmd")
      writeLines(rmd_content, con = rmd_file)

      # Render the R markdown 
      rmarkdown::render(rmd_file, output_format = "html_document", output_file = file)
    }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

You could use a combination of htmlwidgets::saveWidget to save the html map and webshot to create an image of it, then save the rmarkdown similarly as you did before. Also I made the markdown file-name include the current date-time.

Note: I gave the map a constant height of 600 pixels as defined in map_height, so that the outputted map-image is exactly the same size as the shiny map for the user. For this, I use a custom javascript function to retrieve the window dimensions, to adjust the map width to whatever the user sized the window to.

# load libs
using<-function(...) {
  libs<-unlist(list(...))
  req<-unlist(lapply(libs,require,character.only=TRUE))
  need<-libs[req==FALSE]
  if(length(need)>0){ 
    install.packages(need)
    lapply(need,require,character.only=TRUE)
  }
}
using("shiny", "leaflet", "rmarkdown", "mapview", "sf","glue","dplyr","webshot","htmlwidgets")
# parameters
map_height <- 600 # set map height here
#
locations <- data.frame(
  name = c("Location A", "Location B", "Location C", 
           "Location D", "Location E", "Location F", "Location G"),
  lat = c(-27.4698, -27.9997, -27.4533, -27.4743, -27.4699, -27.3846, -27.4495),
  lon = c(153.0251, 153.0147, 153.0350, 153.0282, 153.0157, 153.1173, 153.0336)
) 

locations_sf <- st_as_sf(locations, coords = c("lon", "lat"), crs = 4326)
locations_picker <- sort(locations$name)

ui <- fluidPage(
  selectInput(
    inputId = "location_picker",
    label = "Select a location",
    choices = locations_picker
  ),
  
  leafletOutput("map", height = map_height), # set a constant map height, so we can use that later
  downloadButton(outputId = "download_report", label = "Download report"),
  # this script captures the current shiny window dimensions
  tags$head(tags$script('
                                var dimension = [0, 0];
                                $(document).on("shiny:connected", function(e) {
                                    dimension[0] = window.innerWidth;
                                    dimension[1] = window.innerHeight;
                                    Shiny.onInputChange("dimension", dimension);
                                });
                                $(window).resize(function(e) {
                                    dimension[0] = window.innerWidth;
                                    dimension[1] = window.innerHeight;
                                    Shiny.onInputChange("dimension", dimension);
                                });
                            ')),
)

server <- function(input, output) {
  rv <- reactiveValues(
    selected_location = FALSE,
    current_map = NULL
  )
  
  initial_map <- leaflet(
    options = leafletOptions(
      attributionControl = FALSE
    )
  ) %>%
    addProviderTiles(providers$Esri.WorldGrayCanvas)
  
  output$map <- renderLeaflet(initial_map)
  
  observe({
    rv$selected_location <- input$location_picker
  }) %>%
    bindEvent(input$location_picker)
  
  observe({
    req(rv$selected_location)
    
    selected_location_data <- locations_sf[locations_sf$name == rv$selected_location, ]
    coords <- st_coordinates(selected_location_data)
    
    rv$current_map <- leaflet(
      options = leafletOptions(
        attributionControl = FALSE,
        zoomControl = FALSE
      )
    ) %>%
      addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
      setView(
        lng = coords[1],
        lat = coords[2],
        zoom = 20
      ) %>%
      addMarkers(
        data = selected_location_data,
        label = paste0(
          "<strong>Locality:</strong>", selected_location_data$name, "<p>"
        ) %>% htmltools::HTML()
      )
    
    leafletProxy("map") %>%
      setView(
        lng = coords[1],
        lat = coords[2],
        zoom = 20
      ) %>%
      clearMarkers() %>%
      addMarkers(
        data = selected_location_data,
        label = paste0(
          "<strong>Locality:</strong>", selected_location_data$name, "<p>"
        ) %>% htmltools::HTML()
      )
  }) %>%
    bindEvent(rv$selected_location)
  
  output$download_report <- downloadHandler(
    filename = function() {
      paste0("report_", rv$selected_location, "_", format(Sys.time(), "%y-%m-%d_%H-%M-%S"), ".html")
    },
    content = function(file) {
      # Create a temporary directory
      temp_dir <- tempfile(pattern = "report_")
      dir.create(temp_dir)
      
      # Define file paths
      map_filename <- "map.png"
      html_filename <- "map.html"
      rmd_filename <- "report.Rmd"
      map_path <- file.path(temp_dir, map_filename)
      html_path <- file.path(temp_dir, html_filename)
      rmd_path <- file.path(temp_dir, rmd_filename)
      
      # Save map as HTML first
      htmlwidgets::saveWidget(rv$current_map, html_path, selfcontained = TRUE)
      
      print(paste0("Window width: ", input$dimension[1], ", Window height: ", input$dimension[2]))
      # Convert HTML to PNG using webshot
      tryCatch({
        webshot(url = html_path, 
                file = map_path,
                delay = 0.5,
                vwidth = input$dimension[1], # adjust surrounding width
                vheight = map_height)
        
        # Verify the file was created
        if (!file.exists(map_path)) {
          stop("Map file was not created successfully")
        }
      }, error = function(e) {
        message("Error saving map: ", e$message)
        stop(e)
      })
      
      # Create RMD content
      rmd_content <- sprintf('---
title: "Report for %s"
output: html_document
---

## Map for %s

![Map of location](%s)

This is an example markdown.
', 
                             rv$selected_location,
                             rv$selected_location,
                             knitr::image_uri(map_path)
      )
      
      # Write RMD
      writeLines(rmd_content, con = rmd_path)
      
      # Render to HTML
      tryCatch({
        rmarkdown::render(
          input = rmd_path,
          output_file = file,
          quiet = TRUE,
          envir = new.env(parent = globalenv())
        )
      }, error = function(e) {
        message("Error rendering report: ", e$message)
        stop(e)
      })
      
      # Cleanup
      unlink(temp_dir, recursive = TRUE)
    },
    contentType = "text/html"
  )
}

shinyApp(ui = ui, server = server)

---

Result