Saving leaflet image inside R shiny

Question

I am trying to save a leaflet image in an R shiny app. And can do so when adding simple markers. However recently I have been trying to generalize this code by adding loops and getting issues and wondering if anyone else can help. See the reproducible example below.

    Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014))
    Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084))


    library('leaflet')
    library('shiny')
    library('webshot')
    library('htmlwidgets')


    ##### My take on Example 2
    ui <- fluidPage(
       sidebarPanel(
       checkboxInput('returnpdf', 'output pdf?', FALSE), 
       conditionalPanel(
         condition = "input.returnpdf == true",
         downloadLink('pdflink')
        ) 
       ), 
       mainPanel(leafletOutput("map"))
    )



    server = function(input, output){

    mymap <- reactive({
       leaflet() %>% addTiles()%>%  
       clearShapes() %>%
       clearMarkers() %>%      
       fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
    })

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

    myfun <- function(map) {
        print("adding points")
        map %>% clearShapes() %>%
        clearControls() %>% 
        clearMarkers() %>% 
        addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1)   
     }

    AddStrataPoly <- function(map) {
      print("adding polygons")    
      for(i in 1:length(unique(Poly$Strat))) {
         map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1))
      } 
    }

    observe({
      leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
    })

    newmap <- reactive({
      mymap() %>% myfun() %>% AddStrataPoly()
    })

    output$pdflink <- downloadHandler(
      filename = 'plot.pdf',

      content = function(file) {
        owd <- setwd(tempdir())
        on.exit(setwd(owd))
        saveWidget(newmap(), "temp.html", selfcontained = FALSE)
      }
    )
    }        

This follows the example outlined here. If you run this code (shinyApp(ui, server);) and try click the download link you get the following error

ERROR: 'package' must be of length 1

although the online viewer works fine the issue seems to be with the downloadhandler. I have isolated the issue to the loop in the function AddStrataPoly(). And get the code to work by replacing the AddStrataPoly() function with

    AddStrataPoly <- function(map) {
      print("adding polygons")    
      #for(i in 1:length(unique(Poly$Strat))) {
         i = 1
         map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1))
      #} 
    }

but obviously it plots only one polygon. Can someone please help get this code generalized so I can plot many polygons?

Answer 1

In your AddStrataPoly function, you need to replace the map you passed by the map with the polygons if you want to add them sequentially:

Try this:

AddStrataPoly <- function(map) {
    print("adding polygons")    
    for(i in 1:length(unique(Poly$Strat))) {
      map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1))
    } 
    map
  }

I also modified your downloadHandler to this to make it work:

output$pdflink <- downloadHandler(
    filename = 'temp.html',

    content = function(file) {
      saveWidget(newmap(), file, selfcontained = TRUE)
    }
  )

The selfcontained=TRUE is to have all the dependecies in the file so users can open it as is. I also changed the destination file to file as the function expects the content to be written to there.