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:
The user can choose the data which will be displayed on the map by selecting a column of the DATA dataframe (add_fill_layer)
By selecting a region the map will fit that area (fit_bounds)
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
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.