The position of map (leaflet) not updating from dropdown user input R

Question

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.

Answer 1

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)