Shiny中leaflet双地图同步与leafletProxy兼容问题求助

我正在开发一个Shiny应用，需要两张地图展示同一区域的两种不同场景（类似ggplot中的分面效果）。应用包含时间动画功能，通过leafletProxy实现数据的动态更新。理想状态下，两张地图能像leafsync工具那样实现双向同步，但leafsync似乎无法与leafletProxy兼容。此前已有类似问题被提出，但未得到双向同步的完美解决方案。目前正验证leaflet.minicharts包中的syncWith函数是否可与leafletProxy配合使用。

示例代码 #

options("rgdal_show_exportToProj4_warnings"="none") # 屏蔽rgdal的proj字符串警告
library(shiny)
library(shinyWidgets)
library(leaflet)
library(raster)
library(leafsync)
library(shinydashboard)
library(dplyr) # 补充代码中用到的dplyr包

set.seed(1)
frog <- data.frame(x=sample(seq(from=-105, to=-95,by=.4), 300, replace = T),
                   y = sample(seq(from=35, to=45,by=.4), 300, replace=T),
                   sample1.2000 = runif(300,min=40, max = 250),
                   sample2.2000 = runif(300,min=40, max = 250),
                   sample1.2001 = runif(300,min=10, max = 220),
                   sample2.2001 = runif(300,min=10, max = 220),
                   sample1.2002 = runif(300,min=0, max = 200),
                   sample2.2002 = runif(300,min=0, max = 200)
)
toad <- data.frame(x=sample(seq(from=-105, to=-95,by=.4), 500, replace = T),
                   y = sample(seq(from=35, to=45,by=.4), 500, replace=T),
                   sample1.2000 = runif(500,min=100, max = 750),
                   sample2.2000 = runif(500,min=100, max = 750),
                   sample1.2001 = runif(500,min=500, max = 900),
                   sample2.2001 = runif(500,min=100, max = 600),
                   sample1.2002 = runif(500,min=300, max = 900),
                   sample2.2002 = runif(500,min=50, max = 600)
)

ui <- 
  fluidPage(
    fluidRow(
      box(width = 12,
          box(width=6,
              radioGroupButtons(
                inputId = "species",
                label = "Target Species",
                choiceNames  = list("Frog", 
                                    "Toad"),
                choiceValues = list("frog","toad"),
                selected = "frog",
                justified = TRUE,
                status="primary"
              ),
          ),
          box(width=6,
              sliderInput("year", 
                          label = "Year", min = 2000, 
                          max = 2002, value = 2000,
                          sep="")
          ),
      ),
    ),
    fluidRow( 
      uiOutput('map', height = "150vh") 
    )
  )

server <- function(input, output) {
  
  # 根据物种设置颜色刻度范围
  spp_lim <- eventReactive(input$species, {
    switch(input$species,
           "frog" = c(0:250), # 蛙类最高密度为250
           "toad" = c(0:1000), # 蟾蜍最高密度为1000
    )
  })
  
  # 创建地图颜色调色板
  map_pal <- reactiveValues() 
  
  observe({
    map_pal$pal <- colorNumeric(palette = "plasma", 
                                spp_lim(),
                                na.color = "transparent",
                                reverse=F)
  })
  
  output$map <- renderUI({
    # 创建同步的空白leaflet地图
    sync(
      leaflet(options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
        addProviderTiles("CartoDB.VoyagerNoLabels") %>%
        setView(lng = -100, lat = 40, zoom = 5),
      
      leaflet(options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
        addProviderTiles("CartoDB.VoyagerNoLabels") %>%
        setView(lng = -100, lat = 40, zoom = 5) 
    )
  }) # 结束地图渲染
  
  # 动态添加栅格的观察器
  observe({
    # 获取数据
    map_dat <- get(input$species) %>%
      dplyr::select(x,y, 
                    paste0("sample1.",input$year),
                    paste0("sample2.",input$year)) 
    
    # 栅格化数据
    raster_1 <- rasterFromXYZ(map_dat[,c(1,2,3)],
                              crs = "+init=epsg:4326 +proj=longlat +ellps=WGS84 " )
    raster_2 <- rasterFromXYZ(map_dat[,c(1,2,4)],
                              crs = "+init=epsg:4326 +proj=longlat +ellps=WGS84 ")
    
    # 获取调色板
    pal <-   map_pal$pal
    
    # 核心问题：leafletProxy需要指定单个地图的ID，但当前"map"是整个sync对象，无法精准指定要添加栅格的目标地图
    leafletProxy("map") %>%
      clearImages() %>% 
      addRasterImage(raster_1, colors = pal, opacity = 0.7,
                     project=TRUE)
    
    leafletProxy("map") %>%
      clearImages() %>% 
      addRasterImage(raster_2, colors = pal, opacity = 0.7,
                     project=TRUE)
  })
}

shinyApp(ui = ui, server = server)

代码核心问题 #

leafletProxy需要指定单个地图的ID来进行更新操作，但当前代码中output$map返回的是整个leafsync的同步对象，无法精准指向其中的单个地图，导致无法分别为两张地图添加对应的栅格数据。

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