Extending leaflet proxy with a custom wrapper function in Shiny

Question

Background

I have a Shiny app that makes use of the leaflet providing a set of maps. Some of those maps share similar elements. I would like to cleanup the code a little wrap those elements in a function that I would call across those maps when appropriate.

Reproducible example

To simplify the question I'm making use of the example provide on the leaflet page: Modifying Existing Maps with leafletProxy

I would like to make use of this wrapper function to make those layers available across maps in the app:

# Create wrapper function adding tiles
add_map_layers <- function(map) {
    addProviderTiles(map = map, "Stamen.Toner",     group = "Toner") %>%
        addProviderTiles(map = map, "Stamen.TonerLite", group = "Toner Lite") %>%
        addProviderTiles(map = map, "CartoDB.Positron", group = "Carto") %>%
        addLayersControl(
            map = map,
            baseGroups = c("OSM (default)", "Toner", "Toner Lite", "Carto"),
            options = layersControlOptions(collapsed = FALSE)
        )
}

The function would be added in the following manner:

observe({
    pal <- colorpal()

    leafletProxy("map", data = filteredData()) %>%
        clearShapes() %>%
        addCircles(
            radius = ~ 10 ^ mag / 10,
            weight = 1,
            color = "#777777",
            fillColor = ~ pal(mag),
            fillOpacity = 0.7,
            popup = ~ paste(mag)
        ) %>% 
        add_map_layers()
})

Error

The code produces the following error message:

Warning: Error in unclass: cannot unclass an environment
Stack trace (innermost first):
    92: matchSignature
    91: getMethod
    90: existsMethod
    89: .local
    88: asJSON
    87: asJSON
    86: .local
    85: FUN
    84: FUN
    83: vapply
    82: .local
    81: asJSON
    80: asJSON
    79: .local
    78: FUN
    77: FUN
    76: vapply
    75: .local
    74: FUN
    73: FUN
    72: vapply
    71: .local
    70: FUN
    69: FUN
    68: vapply
    67: .local
    66: FUN
    65: FUN
    64: vapply
    63: .local
    62: FUN
    61: FUN
    60: vapply
    59: .local
    58: FUN
    57: FUN
    56: vapply
    55: .local
    54: asJSON
    53: asJSON
    52: .local
    51: asJSON
    50: asJSON
    49: jsonlite::toJSON
    48: toJSON
    47: private$websocket$send
    46: private$write
    45: private$sendMessage
    44: sess$sendCustomMessage
    43: flushedCallback
    42: callback
     1: shiny::runApp

Questions

• How can I develop wrapper function for often used elements so I could include it in the leaflet pipeline? The goal is simply to minimise on the amount of code that is repeated across the app.

• The function is only supposed to take and return map object so I could develop the pipe:

  leaflet() %>%
  wrapper_function() %>%
  other_leaflet_function() 
  

---

Full example

For convenient copy-paste, I have included full code. As mentioned, the only difference to the official example is the wrapper function add_map_layers that attempts to add map layers to the leaflet object.

library(shiny)
library(leaflet)
library(RColorBrewer)

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", width = "100%", height = "100%"),
    absolutePanel(
        top = 10,
        right = 10,
        sliderInput(
            "range",
            "Magnitudes",
            min(quakes$mag),
            max(quakes$mag),
            value = range(quakes$mag),
            step = 0.1
        ),
        selectInput("colors", "Color Scheme",
                    rownames(subset(
                        brewer.pal.info, category %in% c("seq", "div")
                    ))),
        checkboxInput("legend", "Show legend", TRUE)
    )
)

server <- function(input, output, session) {
    # Create wrapper function adding tiles
    add_map_layers <- function(map) {
        addProviderTiles(map = map, "Stamen.Toner",     group = "Toner") %>%
            addProviderTiles(map = map, "Stamen.TonerLite", group = "Toner Lite") %>%
            addProviderTiles(map = map, "CartoDB.Positron", group = "Carto") %>%
            addLayersControl(
                map = map,
                baseGroups = c("OSM (default)", "Toner", "Toner Lite", "Carto"),
                options = layersControlOptions(collapsed = FALSE)
            )
    }

    # Reactive expression for the data subsetted to what the user selected
    filteredData <- reactive({
        quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2], ]
    })

    # This reactive expression represents the palette function,
    # which changes as the user makes selections in UI.
    colorpal <- reactive({
        colorNumeric(input$colors, quakes$mag)
    })

    output$map <- renderLeaflet({
        # Use leaflet() here, and only include aspects of the map that
        # won't need to change dynamically (at least, not unless the
        # entire map is being torn down and recreated).
        leaflet(quakes) %>% addTiles() %>%
            fitBounds( ~ min(long), ~ min(lat), ~ max(long), ~ max(lat))
    })

    # Incremental changes to the map (in this case, replacing the
    # circles when a new color is chosen) should be performed in
    # an observer. Each independent set of things that can change
    # should be managed in its own observer.
    observe({
        pal <- colorpal()

        leafletProxy("map", data = filteredData()) %>%
            clearShapes() %>%
            addCircles(
                radius = ~ 10 ^ mag / 10,
                weight = 1,
                color = "#777777",
                fillColor = ~ pal(mag),
                fillOpacity = 0.7,
                popup = ~ paste(mag)
            ) %>% 
            add_map_layers()
    })

    # Use a separate observer to recreate the legend as needed.
    observe({
        proxy <- leafletProxy("map", data = quakes)

        # Remove any existing legend, and only if the legend is
        # enabled, create a new one.
        proxy %>% clearControls()
        if (input$legend) {
            pal <- colorpal()
            proxy %>% addLegend(position = "bottomright",
                                pal = pal,
                                values = ~ mag)
        }
    })
}

shinyApp(ui, server)

Answer 1

The correct syntax:

add_map_layers <- function(map) {
    map %>% 
    addProviderTiles("Stamen.Toner",     group = "Toner") %>%
        addProviderTiles("Stamen.TonerLite", group = "Toner Lite") %>%
        addProviderTiles("CartoDB.Positron", group = "Carto") %>%
        addLayersControl(
            baseGroups = c("OSM (default)", "Toner", "Toner Lite", "Carto"),
            options = layersControlOptions(collapsed = FALSE)
        )
}