rshinymapboxr-leaflet

How to add a Mapbox layer using R, Shiny, and Mapboxer?


I have an Shiny application using Leaflet. I will migrate it to Mapbox using mapboxer library.

My main question is how to adapt the scenario below:

  1. The user can choose the data which will be displayed on the map by selecting a column of the DATA dataframe (add_fill_layer)

  2. By selecting a region the map will fit that area (fit_bounds)

  3. Get event when the map is clicked on a region and/or on mouse hover

Find below a reproducible example

global.R

library(dplyr)
library(shiny)
library(leaflet)
library(mapboxer)
library(purrr)
library(sf)

MAPBOX_TOKEN <- "THIS_HAVE_TO_BE_A_VALID_MAPBOX_TOKEN"

MELBOURNE_MAP <- sf::st_read(geojsonsf::geo_melbourne)

places <- as.data.frame(MELBOURNE_MAP) %>% select(SA2_NAME) %>% pull() %>% append("All regions", 0)

places_length <- length(places)

Names <- as.vector(places[2 : places_length])
ColA <- as.vector(sample(1 : 100, size = places_length - 1, replace = TRUE))
ColB <- as.vector(sample(1 : 100, size = places_length - 1, replace = TRUE))

MELBOURNE_DATA <- data.frame(Names = Names, ColA = ColA, ColB = ColB)

ui.R

ui <- fluidPage(
  selectInput("Region", label = "Region", choices = places),
  selectInput("Column", label = "Column", choices = c("ColA", "ColB")),
  h1("Leaflet Map"),
  uiOutput("clicked_leaflet_region"),
  leafletOutput("leafletMap", width = "50%"),
  h1("Mapbox Map"),
  uiOutput("clicked_mapbox_region"),
  mapboxerOutput("mapboxMap", width = "50%"),
)

server.R

server <- function(input, output, session) {
  bbox <- reactive ({
    st_bbox(MELBOURNE_MAP$geometry) %>% as.vector()
  })
  
  output$leafletMap <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 10, maxZoom = 200, zoomControl = TRUE, zoomSnap = 0.5)) %>%
      addProviderTiles("Esri.WorldGrayCanvas") %>%
      fitBounds(bbox()[1], bbox()[2], bbox()[3], bbox()[4])
  })
  
  output$mapboxMap <- renderMapboxer({
    mapboxer(style = "mapbox://styles/mapbox/light-v11", token = MAPBOX_TOKEN) %>%
      fit_bounds(bbox())
  })
  
  data_to_show <- eventReactive(input$Column, {
    MELBOURNE_DATA %>% select(Name, get(input$Column))
  })
  
  update_leafletMap <- function(column, region=NULL) {
    pal <- colorBin(c("#EDF8E9", "#C7E9C0", "#A1D99B", "#74C476", "#31A354", "#006D2C"),
                    domain = c(1: 100),
                    bins = c(0, 25, 50, 100))
    
    pallete <- pal(MELBOURNE_DATA[[column]])
    
    hlopts <- highlightOptions(
      weight = 5,
      color = "#666666",
      fillOpacity = 0.7)
    
    p <- leafletProxy("leafletMap")
    
    p <- p %>% clearShapes() %>% clearControls()
    
    p <- p %>% addPolygons(data = MELBOURNE_MAP,
                           weight = 1,
                           color = "white",
                           smoothFactor = 0.5,
                           fillOpacity = 0.8,
                           fillColor = pallete,
                           highlight = hlopts,
                           group = "By Name",
                           layerId = MELBOURNE_MAP$SA2_NAME)
    
    if (region == "All regions") {
      p <- p %>% fitBounds(bbox()[1], bbox()[2], bbox()[3], bbox()[4])
    } else {
      l <- MELBOURNE_MAP %>% filter(SA2_NAME == region) %>% select(geometry)
      bbox <- st_bbox(l$geometry) %>% as.vector()
      p <- p %>% fitBounds(bbox[1], bbox[2], bbox[3], bbox[4])
    }    
    p
  }
  
  update_mapboxMap <- function(column, region) {
    p <- mapboxer_proxy("mapboxMap")
    p <- p %>% add_fill_layer()   # What to do here??? Please, see note 1 above.

    if (region == "All regions") {
      p <- p %>% fit_bounds(bbox())
    } else {
      l <- MELBOURNE_MAP %>% filter(SA2_NAME == region) %>% select(geometry)
      bbox <- st_bbox(l$geometry) %>% as.vector()
      p <- p %>% fit_bounds(bbox)  # This is not working!!! Please, see note 2 above
    }    
    p
  }
  
  observeEvent(c(input$Region, input$Column), {
    update_leafletMap(input$Column, input$Region)
    update_mapboxMap(input$Column, input$Region)
  })
  
  observeEvent(input$leafletMap_shape_click, {
    event <- input$leafletMap_shape_click
    output$clicked_leaflet_region <- renderUI({ HTML(paste0("<h2>",event$id,"</h2>")) })
  })
}

This simple example works as expected when using Leaflet, but not for Mapbox.

Please, by commenting below, let me know if any other information is necessary for helping answering this issue.

I tried to feed add_fill_layer with as_mapbox_source method by using MELBOURNE_MAP, MELBOURNE_DATA, and merging them.

Updated on Dec 3rd, 2022

enter image description here

enter image description here


Solution

  • You have to to call the update function update_mapboxer in the end. Usually you won't call the add_layer function but only update the data with set_data. See this example.