I have a global variable called map_status, selectedDropdownData.
mapStatus <<- list(map_lng = -110.9747, map_lat = 32.2226, map_zoom = 12)
selectedDropdownData <<- NULL
I currently implemented the following and it works good. Following is map.r
library(leaflet)
render_leaflet_map <- function(mapData, mapStatus, palette_colors = c("green", "yellow", "orange", "red"), min_zoom = 7, max_bounds_lat = c(31.3322, 37.0043), max_bounds_lng = c(-114.8183, -109.0452)) {
if (is.null(mapData)) return(NULL)
data <- mapData$data
dataset <- mapData$dataset
print(paste("From render lealet mapstatus", mapStatus))
# Compute range of the data to create breakpoints for the color palette
data_range <- range(data[[dataset]], na.rm = TRUE)
breaks <- quantile(data[[dataset]], probs = seq(0, 1, length.out = 5), na.rm = TRUE) # Create 4 intervals
# Create a color palette based on the breaks
pal <- colorBin(palette = palette_colors, domain = data[[dataset]], bins = breaks, na.color = "transparent")
leaflet(data, options = leafletOptions(minZoom = min_zoom, maxBounds = list(lat = max_bounds_lat, lng = max_bounds_lng))) %>%
addTiles() %>%
setView(lng = mapStatus[['map_lng']], lat = mapStatus[['map_lat']], zoom = mapStatus[['map_zoom']]) %>%
addPolylines(
color = ~pal(data[[dataset]]),
weight = 4,
opacity = 1,
labelOptions = labelOptions(
direction = 'auto',
noHide = FALSE,
textOnly = FALSE,
style = list('background' = 'rgba(255, 255, 255, 0.8)', 'padding' = '5px', 'border' = '1px solid #cccccc')
)
) %>%
addLegend(
position = "bottomright",
pal = pal,
values = ~data[[dataset]],
title = "Range,
opacity = 0.7,
labFormat = labelFormat(prefix = "", suffix = "")
)
}
set_map_status <- function(mapStatus) {
print("Inside set_map_status")
mapStatus$map_lng <<- mapStatus$map_lng
mapStatus$map_lat <<- mapStatus$map_lat
mapStatus$map_zoom <<- mapStatus$map_zoom
print(paste(":):):):):) mapStatus", mapStatus))
}
# Function to observe and maintain the zoom status of maps
observe_map_status <- function(input, mapStatus) {
observe({
req(input$map_center, input$map_zoom)
isolate({
if (!is.null(input$map_center) &&
(input$map_center$lat != mapStatus$map_lat ||
input$map_center$lng != mapStatus$map_lng ||
input$map_zoom != mapStatus$map_zoom)) {
mapStatus$map_lng <<- input$map_center$lng
mapStatus$map_lat <<- input$map_center$lat
mapStatus$map_zoom <<- input$map_zoom# Increment the render trigger
print(paste("In map if"))
}
set_map_status(mapStatus)
})
})
}
I call these functions in server.r
# Call the observe_map_status function
observe_map_status(input, mapStatus)
# Render the heat map
output$map <- renderLeaflet({
mapData <- currentMapData()
render_leaflet_map(mapData, mapStatus)
})
The above code works and maintains the map status when the user zooms in/out, applies filters etc. But now I also want the map to zoom in to the location depending on the input user selected from the dropdown. I wrote a similar function in map.r
observe_selectedDropdownData <- function(mapStatus, selectedDropdownData) {
observe({
isolate({
if ((!is.null(selectedDropdownData))) {
print(paste("In observe_selectedDropdownData"))
print(paste("selectedDropdownData$latitude ", selectedDropdownData$latitude))
print(paste("selectedDropdownData$longitude ", selectedDropdownData$longitude))
centerLat <- mean(range(selectedDropdownData$latitude))
centerLng <- mean(range(selectedDropdownData$longitude))
print(paste("centerLat ", centerLat))
print(paste("centerLng ", centerLng))
mapStatus$map_lng <<- centerLat
mapStatus$map_lat <<- centerLng
mapStatus$map_zoom <<- 10# Increment the render trigger
}
})
set_map_status(mapStatus)
print(paste("Mapstatus ", mapStatus))
})
}
and tried calling it in server.r as follows
observe({
req(input$subCorridorSelect)
if (!is.null(input$subCorridorSelect)) {
selectedDropdownData <<- dropdownData()[dropdownData()$sub_corridor == input$subCorridorSelect, ]
} else {
selectedDropdownData <<- NULL # Keep selectedData as NULL if no selection is made
}
observe_selectedDropdownData(mapStatus, selectedDropdownData)
})
The value of map status gets updated. But that region is not zoomed in the map.
I suspect you want to use leafletProxy() to update your map. I'll try and put together an example and edit this when I have.
Edit:
sorry the code is using scraps from a recent project, but I think the gist is there, for me, with changing dropdown input the map zoom changes. Hope this helps
library(shiny)
library(leaflet)
library(sf)
library(bcmaps)
library(rmapshaper)
library(dplyr)
# a bit of data so we have something to look at
ha <- bcmaps::health_ha() %>%
rmapshaper::ms_simplify(., keep = 0.05, keep_shapes = TRUE) %>%
rename_with(tolower, everything()) %>%
select(ha_code = hlth_authority_code,
ha_name = hlth_authority_name,
geometry) %>%
st_transform(crs = 4326) %>%
mutate(color = c("#3891A7",
"#C3860D",
"#C42E2E",
"#67A63C",
"#914FAB"))
ui <- fluidPage(
leafletOutput("main_map"),
selectInput("dropdown",
label = "Select Region Zoom",
choices = c("Full" = "full",
"Northern" = "northern"))
)
server <- function(input, output, session) {
output$main_map <- renderLeaflet({
leaflet() %>%
addProviderTiles('CartoDB.Voyager',
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data = ha,
stroke = TRUE,
weight = 1,
color = ~color,
opacity = 0.5,
fillColor = ~color,
fillOpacity = 0.3) %>%
setView(-129.5068359375,
53.772328589611,
zoom = 4)
})
observeEvent(input$dropdown,{
if(input$dropdown == "full"){
leafletProxy("main_map") %>%
setView(-129.5068359375,
53.772328589611,
zoom = 4)
} else if(input$dropdown == "northern"){
leafletProxy("main_map") %>%
setView(-128.022682517767,
57.7510758024181,
zoom = 5)
}
})
}
shinyApp(ui, server)