Save leaflet map in shiny with user selected layers

Question

I have a shiny app in which I have a leaflet map. I have managed to include the ability for an individual to save the map with their own preferred zoom and boundaries (thanks to this answer) and can remove the zoom controls in the saved image (thanks to this answer). However, I would now like to be able to save the map with the layers that the user has selected themselves.

Here is a short example code which runs:

library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)

ui <- fluidPage(
  fluidPage(
    leafletOutput(outputId = "map"),
    downloadButton(outputId = "save")
  )
)

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

  map <- reactive({
    leaflet() %>%
      setView(lng = -117, lat = 37, zoom = 7) %>%
      addTiles() %>%
      addMarkers(lng = -115.172813, lat = 36.114647,
                 group = "Vegas") %>%
      addMarkers(lng = -119.538330, lat = 37.865101,
                 group = "Yosemite") %>%
      addLayersControl(overlayGroups = c("Vegas", "Yosemite"),
                       options = layersControlOptions(collapsed = F)) %>%
      hideGroup("Yosemite")
  })

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

  output$save <- downloadHandler(
    filename = "map.png",
    content = function(file){
      latRng <- range(input$map_bounds$north,
                      input$map_bounds$south)
      lngRng <- range(input$map_bounds$east,
                      input$map_bounds$west)
      m <- map() %>%
        setView(lng = (lngRng[1] + lngRng[2])/2,
                lat = (latRng[1] + latRng[1])/2,
                zoom = input$map_zoom)
      m$x$options <- append(m$x$options, list("zoomControl" = F))
      mapshot(m, file = file)
    }
  )

}

shinyApp(ui, server)

In this app the image that is created when a user clicks Download only includes the default layer Yosemite, even if Vegas has been selected as well/instead.

I am also interested in a way of hiding the layerControl options in the saved image but this is secondary to my main question.

Thanks

Cristian E. Nuno · Answer 1 · 2018-03-26T04:12:01.527

Overview

Create a series of if-else control statements which captures the groups your users add or remove while using the Shiny app.

Down below, I test which overlay groups are currently checked - which are stored as an inherent input value/events (in this case, input$MAPID_groups) - and modify map to show the groups which are checked. I store these modifications in user.map(), which is a reactive() expression, since the modifications made to the map will change over time.

To remove the layers control from appearing in PNG file, use removeLayersControl() when modifying user.map().

# load necessary packages
library( shiny )
library( leaflet )
library( mapview )

ui <- 
  fluidPage(
    leafletOutput(outputId = "map")
    , downloadButton(outputId = "save")
  )

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

  # create foundational map
  map <- reactive({
    leaflet() %>%
      setView(lng = -117, lat = 37, zoom = 7) %>%
      addTiles() %>%
      addMarkers( lng = -115.172813
                 , lat = 36.114647
                 , group = "Vegas") %>%
      addMarkers( lng = -119.538330
                  , lat = 37.865101
                 , group = "Yosemite" ) %>%
      addLayersControl( overlayGroups = c( "Vegas", "Yosemite" )
                       , options = layersControlOptions( collapsed = FALSE ) ) %>%
      hideGroup( group = "Yosemite")
  })

  # render foundational map
  output$map <- renderLeaflet({
    map()
  })

  # create reactive leaflet maps
  # based on the user's actions
  # inside the Shiny app
  user.map <- reactive({

    # create a series of if-else statements
    # that capture the click event of the user
    # adding/removing overlay groups
    # and modify the map to meet the user's 
    # specifications
    if( is.null( input$map_groups ) ){

      # show no markers when
      # no overlay groups are selected
      user.map <-
        map() %>%
        setView(lng = input$map_center$lng,
                lat = input$map_center$lat,
                zoom = input$map_zoom) %>%
        hideGroup( group = "Vegas" ) %>%
        hideGroup( group = "Yosemite" ) %>%
        removeLayersControl()

      # remove the zoom control
      # from the map
      user.map$x$options <-
        append(
          x = user.map$x$options
          , values = list("zoomControl" = FALSE )
        )

      # return user.map
      # to the Global Environment
      return( user.map )

    } else if( identical( x = c( "Vegas", "Yosemite" )
                          , y = input$map_groups ) ){

      # show all markers
      # when both groups are selected
      user.map <- 
        map() %>%
        setView(lng = input$map_center$lng,
                lat = input$map_center$lat,
                zoom = input$map_zoom) %>%
        showGroup( group = "Vegas" ) %>%
        showGroup( group = "Yosemite" ) %>%
        removeLayersControl() 

      # remove the zoom control
      # from the map
      user.map$x$options <-
        append(
          x = user.map$x$options
          , values = list("zoomControl" = FALSE )
        )

      # return user.map
      # to the Global Environment
      return( user.map )

    } else if( input$map_groups == "Vegas" ){

      # show only the Vegas group
      user.map <-
        map() %>%
        setView(lng = input$map_center$lng,
                lat = input$map_center$lat,
                zoom = input$map_zoom) %>%
        removeLayersControl()

      # remove the zoom control
      # from the map
      user.map$x$options <-
        append(
          x = user.map$x$options
          , values = list("zoomControl" = FALSE )
        )

      # return user.map
      # to the Global Environment
      return( user.map )

    } else if( input$map_groups == "Yosemite" ){

      # show only the Yosemite group
      user.map <-
        map() %>%
        setView(lng = input$map_center$lng,
                lat = input$map_center$lat,
                zoom = input$map_zoom) %>%
        hideGroup( group = "Vegas") %>%
        showGroup( group = "Yosemite") %>%
        removeLayersControl()

      # remove the zoom control
      # from the map
      user.map$x$options <-
        append(
          x = user.map$x$options
          , values = list("zoomControl" = FALSE )
        )

      # return user.map
      # to the Global Environment
      return( user.map )

      } 
  })

  output$save <- downloadHandler(
    filename = "map.png",
    content = function(file){

      # place the reactive leaflet map
      # inside of mapshot to 
      # save and download the map as a png
      mapshot(
        x = user.map()
        , file = file
        )
    }
  )


}

# Run the shiny app
shinyApp(ui, server)

# end of script #

Session Info

R version 3.4.3 (2017-11-30)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS High Sierra 10.13.2

Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets 
[6] methods   base     

other attached packages:
[1] mapview_2.3.0      leaflet_1.1.0.9000
[3] shiny_1.0.5       

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.15      compiler_3.4.3    pillar_1.2.1     
 [4] plyr_1.8.4        R.methodsS3_1.7.1 R.utils_2.6.0    
 [7] base64enc_0.1-3   iterators_1.0.9   class_7.3-14     
[10] tools_3.4.3       gdalUtils_2.0.1.7 digest_0.6.15    
[13] jsonlite_1.5      viridisLite_0.3.0 satellite_1.0.1  
[16] lattice_0.20-35   png_0.1-7         rlang_0.2.0      
[19] foreach_1.4.4     DBI_0.8           crosstalk_1.0.0  
[22] yaml_2.1.17       rgdal_1.2-16      e1071_1.6-8      
[25] raster_2.6-7      htmlwidgets_1.0   webshot_0.5.0    
[28] stats4_3.4.3      classInt_0.1-24   grid_3.4.3       
[31] sf_0.6-0          R6_2.2.2          sp_1.2-7         
[34] udunits2_0.13     magrittr_1.5      scales_0.5.0     
[37] codetools_0.2-15  htmltools_0.3.6   units_0.5-1      
[40] rsconnect_0.8.5   mime_0.5          xtable_1.8-2     
[43] colorspace_1.3-2  httpuv_1.3.6.2    munsell_0.4.3    
[46] R.oo_1.21.0

Save leaflet map in shiny with user selected layers

1 Answers1

Overview

Session Info