R语言Leaflet Proxy仅显示最后添加图层的问题求助

核心问题分析 #

1. readRDS语法错误：原代码中数据读取语句写法颠倒，未正确完成变量赋值
2. Leaflet Proxy更新逻辑缺陷：原代码先清除并添加致命事故图层，随后又清除重伤事故图层并重新添加，导致致命事故图层内容被后续操作覆盖，最终仅最后添加的图层能在控件切换时正常显示
3. 动态更新的一致性问题：初始渲染的是社区层级数据，切换到州级时未确保两个基础图层组都被完整替换为对应层级数据

修改步骤 #

• 修正readRDS的赋值语法
• 调整observe块的更新逻辑：先一次性清除两个基础图层组内容，再依次添加当前层级的致命/重伤事故图层
• 优化reactive数据的容错处理，确保空筛选时返回完整数据集

完整修复代码 #

library(sf)
library(tidyverse)
library(leaflet)
library(shiny)
library(leaflet.extras)
library(ggplot2)
library(htmlwidgets)
library(dplyr)

# 修正数据读取语法
land <- readRDS("stackoverflow_state.rds")
communities <- readRDS("stackoverflow_communities.rds")

pal_leaf_heavy= colorFactor(palette = c("red", "yellow", "green", "darkgreen"), 
                      levels = c(4, 3,2,1))

pal_leaf_fatal = colorFactor(palette=c("yellow", "green", "darkgreen"),
                             levels=c(3,2,1))


ui = fluidPage(
  sidebarLayout(position = "left",
                sidebarPanel(
                  checkboxGroupInput("regiostar_selection", "Regiostarklasse", 
                                     choices=c(51,52,53,54),
                                     selected=c(51,52,53,54),
                                     inline=TRUE),
                  radioButtons("level", "Ebene: ", choices=c("Gemeinde", "Bundesland"), inline=TRUE, selected="Gemeinde")
                ),
                mainPanel( width=12,
                           column(8, leafletOutput("map", height="85vh"))
                )
  )
)

server <- function(input, output, session){
  f_communities <- reactive({
    if(length(input$regiostar_selection) > 0){
      communities %>% filter(RegioStaRGem5 %in% input$regiostar_selection)
    } else {
      communities
    }
  })
  
  level_data <- reactive({
    switch(input$level,
           "Gemeinde" = f_communities(),
           "Bundesland" = land
    )
  })
  
  output$map=renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      # 初始加载社区层级数据
      addPolygons(data=communities, 
                  layerId = communities$AGS, 
                  col=pal_leaf_heavy(communities$heavy_rating), 
                  label=communities$GEN, 
                  group="Entwicklung Unfaelle mit Schwerstverletzten") %>%
      addPolygons(data=communities, 
                  col=pal_leaf_fatal(communities$fatal_rating), 
                  group="Entwicklung toedliche Unfaelle", 
                  label=communities$GEN,
                  layerId=communities$AGS) %>%
      addLegend(colors=c("darkgreen","lightgreen", "yellow", "red"), 
                labels = c("Zielwert für 2030 erreicht", "Jahresziel erreicht", "Zahlen sind gesunken seit 2019, aber Jahresziel nicht erreicht", "Zahlen seit 2019 nicht gesunken" ), 
                group="Legend Unfaelle mit Schwerstverletzten") %>%
      addLegend(colors=c("darkgreen", "lightgreen", "yellow"),
                labels=c("Vision Zero erreicht", "Zielwert für 2030 erreicht", "Ziel noch nicht erreicht"),
                group="Legend toedliche Unfaelle") %>%
      addLayersControl(baseGroups = c("Entwicklung Unfaelle mit Schwerstverletzten", "Entwicklung toedliche Unfaelle"),
                       overlayGroups = c("Legend Unfaelle mit Schwerstverletzten", "Legend toedliche Unfaelle")) %>%
      addSearchOSM(options=searchOptions(collapsed = FALSE, zoom = 9))
  })
  
  observe({
    current_data <- level_data()
    
    leafletProxy("map", data=current_data) %>%
      # 先清除两个基础图层组的所有内容
      clearGroup(group="Entwicklung toedliche Unfaelle") %>%
      clearGroup(group="Entwicklung Unfaelle mit Schwerstverletzten") %>%
      # 依次添加当前层级的两个图层
      addPolygons(col=pal_leaf_fatal(current_data$fatal_rating), 
                  group="Entwicklung toedliche Unfaelle", 
                  label=current_data$GEN,
                  layerId=current_data$AGS) %>%
      addPolygons(layerId = current_data$AGS, 
                  col=pal_leaf_heavy(current_data$heavy_rating), 
                  label=current_data$GEN, 
                  group="Entwicklung Unfaelle mit Schwerstverletzten")
  })
  
}

shinyApp(ui=ui,server=server)

关键修改说明 #

1. 修正数据读取：将错误的readRDS(land, "xxx.rds")改为标准赋值语法land <- readRDS("xxx.rds")，确保数据正确加载
2. 调整更新顺序：先清除两个基础图层组，再分别添加对应层级的图层，保证两个组都有可用内容，图层切换控件可正常触发显示
3. 提取当前数据变量：将level_data()赋值给current_data，避免重复调用reactive表达式，提升性能同时减少潜在逻辑错误

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