如何在Shiny应用的Leaflet Minimap中添加标记？

问题 #

基于Shiny框架开发的应用，选择地点后主地图会添加对应标记，但标记未同步显示在Minimap小地图中，需要实现标记在小地图同步展示。

解决方案 #

Leaflet的MiniMap插件默认仅加载底图，不会自动同步主地图的自定义标记图层。通过以下步骤实现同步：

1. 添加自定义消息监听（UI部分） #

在UI的tags$head中添加JS代码，用于接收主地图标记更新的消息，并同步更新小地图图层：

tags$script(HTML("
  Shiny.addCustomMessageHandler('syncMiniMapMarkers', function() {
    var mainMap = $('.leaflet').data('leaflet-map');
    var miniMap = mainMap.minimap;
    
    if (!miniMap) return;
    
    // 移除小地图中旧的标记图层
    var oldMarkerLayer = miniMap._miniMap.layerManager.getLayer('group', 'Pintar');
    if (oldMarkerLayer) {
      miniMap._miniMap.removeLayer(oldMarkerLayer);
    }
    
    // 获取主地图的最新标记图层并添加到小地图
    var newMarkerLayer = mainMap.layerManager.getLayer('group', 'Pintar');
    if (newMarkerLayer) {
      miniMap._miniMap.addLayer(newMarkerLayer);
    }
  });
"))

2. 更新标记后触发同步（Server部分） #

在observeEvent(input$consultar)中，每次更新主地图标记后，发送消息触发小地图同步：

observeEvent(input$consultar, {
  mapProxy <- leafletProxy("map")
  mapProxy %>%
    clearGroup("Pintar") %>% 
    addAwesomeMarkers(data = topologia_consulta(),
                      lng = ~longitud,
                      lat = ~latitud,
                      group = "Pintar",
                      popup =  ~paste0(
                        "<b>Isla:</b> ", etiqueta, "</b><br/>",
                        "<b>GeoCode:</b> ", geocode, "</b><br/>",
                        "<b>Valor:</b> ", valor, "<br/>"
                      )
    )
  
  # 触发小地图同步标记
  session$sendCustomMessage("syncMiniMapMarkers", list())
})

3. 初始化同步（可选） #

如果需要在地图初始化时就同步现有标记，在htmlwidgets::onRender的JS代码中添加延迟执行的同步逻辑：

// 初始化时同步标记到小地图
setTimeout(function() {
  var miniMap = myMap.minimap;
  if (miniMap) {
    var markerLayer = myMap.layerManager.getLayer('group', 'Pintar');
    if (markerLayer) {
      miniMap._miniMap.addLayer(markerLayer);
    }
  }
}, 1000);

修改后的完整代码 #

library(shiny)
library(leaflet)
library(leaflet.extras)
library(shinyjs)
library(tidyverse)

leafletMiniMapDependencies <- function() {
  list(
    htmltools::htmlDependency(
      "leaflet-minimap",
      "3.3.1",
      "htmlwidgets/plugins/Leaflet-MiniMap",
      package = "leaflet",
      script = c("Control.MiniMap.min.js", "Minimap-binding.js"),
      stylesheet = c("Control.MiniMap.min.css")
    )
  )
}

addMiniMap <- function(
  map,
  position = "bottomleft",
  width = 300,
  height = 225,
  collapsedWidth = 19,
  collapsedHeight = 19,
  zoomLevelOffset = -5,
  zoomLevelFixed = 6,
  centerFixed = c(28, -15.5),
  zoomAnimation = FALSE,
  toggleDisplay = T,
  autoToggleDisplay = FALSE,
  minimized = FALSE,
  aimingRectOptions = list(color = "rgba(0,0,0,0)", weight = 1, clickable = FALSE),
  shadowRectOptions = list(color = "#000000", weight = 1, clickable = FALSE,
                           opacity = 0, fillOpacity = 0),
  strings = list(hideText = "Hide MiniMap", showText = "Show MiniMap"),
  tiles = NULL,
  mapOptions = list(minZoom = 6, maxZoom = 6)
) {
  
  # determin tiles to use
  tilesURL <- NULL
  tilesProvider <- NULL
  if (!is.null(tiles)) {
    if (tiles %in% providers) {
      map$dependencies <- c(map$dependencies, leafletProviderDependencies())
      tilesProvider <- tiles
    } else {
      tilesURL <- tiles
    }
  }
  
  map$dependencies <- c(map$dependencies, leafletMiniMapDependencies())
  invokeMethod(
    map
    , getMapData(map)
    , "addMiniMap"
    , tilesURL
    , tilesProvider
    , position
    , width
    , height
    , collapsedWidth
    , collapsedHeight
    , zoomLevelOffset
    , zoomLevelFixed
    , centerFixed
    , zoomAnimation
    , toggleDisplay
    , autoToggleDisplay
    , minimized
    , aimingRectOptions
    , shadowRectOptions
    , strings
    , mapOptions
  )
}

topologia <- data.frame(
  etiqueta = c("El Hierro", "Fuerteventura", "Gran Canaria",  "La Palma", "Lanzarote", "Tenerife"),
  longitud = c(-18.038165, -14.004885, -15.606239, -17.857377, -13.636218, -16.621481),
  latitud = c(27.743606, 28.400363, 27.958157, 28.655223, 29.039468, 28.293378),
  geocode = c("ES703", "ES704", "ES705", "ES707", "ES708", "ES709"),
  valor = 1:6
)

topologia <-  topologia %>% 
  mutate(
    longitud = as.numeric(gsub("\\.", "", longitud)) / 10^6,
    latitud = as.numeric(gsub("\\.", "", latitud)) / 10^6
  )

# Define UI for application
ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      body{
      .leaflet-control-search{
        position: absolute !important;
        left: 50% !important;
        transform: translateX(-50%) !important;
        margin-left: 0 !important;
      }

      .leaflet-top.leaflet-left{
        width: 100%;
      }
      ")),
    # 添加小地图同步的JS监听
    tags$script(HTML("
      Shiny.addCustomMessageHandler('syncMiniMapMarkers', function() {
        var mainMap = $('.leaflet').data('leaflet-map');
        var miniMap = mainMap.minimap;
        
        if (!miniMap) return;
        
        // 移除小地图中旧的标记图层
        var oldMarkerLayer = miniMap._miniMap.layerManager.getLayer('group', 'Pintar');
        if (oldMarkerLayer) {
          miniMap._miniMap.removeLayer(oldMarkerLayer);
        }
        
        // 获取主地图的最新标记图层并添加到小地图
        var newMarkerLayer = mainMap.layerManager.getLayer('group', 'Pintar');
        if (newMarkerLayer) {
          miniMap._miniMap.addLayer(newMarkerLayer);
        }
      });
    "))
    
  ),
  
  useShinyjs(),
  titlePanel("Mapa"),
  sidebarPanel(
    selectInput("provincia_seleccionada", "Provincia", choices = unique(topologia$etiqueta)), 
    actionButton("consultar", "Consulta")
  ),
  column(width = 12, leafletOutput("map", height = "600px")),
  column(width = 12, dataTableOutput("data"))
)

# Define server logic
server <- function(input, output, session) {
  
  # processing with click of consultar data
  topologia_consulta <- eventReactive(input$consultar, {
    topologia %>% filter(etiqueta %in% input$provincia_seleccionada) %>% 
      filter(!is.na(latitud) & !is.na(longitud))
  })
  
  # show data in datatable
  output$data <- renderDataTable(topologia_consulta())
  
  
  # Render the map
  output$map <- renderLeaflet({
    leaflet() %>%
      leaflet(options = leafletOptions(minZoom = 5)) %>%
      addTiles(options = tileOptions(updateWhenIdle = TRUE, updateWhenZooming = FALSE)) %>%
      addFullscreenControl() %>%
      addProviderTiles(providers$OpenStreetMap) %>%
      setView(lat = 40.416775, lng = -3.703790, zoom = 6) %>%
      addMiniMap() %>%
      addEasyButton(easyButton(
        icon = "fa-crosshairs", title = "Locate Me",
        onClick = JS("function(btn, map){ map.locate({setView: true}); }")
      )) %>%
      leaflet.extras::addSearchOSM(options = searchOptions(collapsed = F)) %>%
      addEasyButton(easyButton(states = list(
        easyButtonState(
          stateName = "Canarias",
          icon = '<strong>Ir a Islas Canarias</strong>',
          title = "Ir a Islas Canarias",
          onClick = JS("
          function(btn, map) {
            map.flyTo(L.latLng(28, -15.5), 7);
            btn.state('Peninsula');
          }")
        ),
        easyButtonState(
          stateName = "Peninsula",
          icon = '<strong>Ir a Península</strong>',
          title = "Ir a Península",
          onClick = JS("
          function(btn, map) {
            map.flyTo(L.latLng(40.416775, -3.703790), 6);
            btn.state('Canarias');
          }")
        )), id = 'botonCanarias', position = 'bottomleft')) %>% 
      
      htmlwidgets::onRender(paste0("
        function(el, t) {
          var myMap = this;
          
       $('#searchtext25').attr('placeholder', 'Buscar localización...');

          $('#searchtext25').on('input', function(){
            if($(this).val() === '')
              $(\"path.leaflet-interactive[stroke='#3388ff'][stroke-linecap='round']\").hide();
          });

          $('#map ul.search-tooltip').on('mouseup', 'li', function(){
            $(\"path.leaflet-interactive[stroke='#3388ff'][stroke-linecap='round']\").show();
          });

          $('#map a.search-cancel').on('click', function(){
            $(\"path.leaflet-interactive[stroke='#3388ff'][stroke-linecap='round']\").hide();
          });
          
          // 初始化时同步标记到小地图
          setTimeout(function() {
            var miniMap = myMap.minimap;
            if (miniMap) {
              var markerLayer = myMap.layerManager.getLayer('group', 'Pintar');
              if (markerLayer) {
                miniMap._miniMap.addLayer(markerLayer);
              }
            }
          }, 1000);
        }")) %>% 
      addLayersControl(
        overlayGroups = c("Pintar"),
        options = layersControlOptions(collapsed = TRUE)
      )
  })
  
 # When click in consultar bottom show the map 
  observeEvent(input$consultar, {
    mapProxy <- leafletProxy("map")
    mapProxy %>%
      clearGroup("Pintar") %>% 
    addAwesomeMarkers(data = topologia_consulta(),
                      lng = ~longitud,
                      lat = ~latitud,
                      group = "Pintar",
                      popup =  ~paste0(
                        "<b>Isla:</b> ", etiqueta, "</b><br/>",
                        "<b>GeoCode:</b> ", geocode, "</b><br/>",
                        "<b>Valor:</b> ", valor, "<br/>"
                      )
    )
    
    # 触发小地图同步标记
    session$sendCustomMessage("syncMiniMapMarkers", list())
  })
}

# Run the application
shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者Raq