R Shiny应用中Leaflet地图图标无法随子行业选择变更求助

核心错误点 #

• 变量名大小写不匹配：第一个geo_icon reactive中，过滤icon_tbl时用了input$sub_sector，但UI中所有子行业选择框的ID都是subSector（驼峰式），导致无法正确匹配子行业，获取不到对应图标URL。
• 重复定义Reactive对象：在observeEvent内部重新定义了geo_icon reactive，这不仅冗余，还会导致外部的geo_icon失效，无法正确响应input$subSector的变化。
• 地图更新逻辑受限：当前地图仅在点击submitButton时重新渲染，且使用uiOutput生成地图，无法实时响应input$subSector的切换；注释掉的leafletProxy逻辑是正确的方向，但未启用。

修正步骤 #

1. 修复变量名错误
   将第一个geo_icon reactive中的input$sub_sector改为input$subSector：

   geo_icon <- reactive({
     req(!is.null(input$subSector), input$upload)
     icons(
       iconUrl = icon_tbl |>
         filter(sub_sector == input$subSector) |>
         pull(icon_url),
       iconWidth = 40,
       iconHeight = 40,
       iconAnchorX = 22,
       iconAnchorY = 30,
       shadowWidth = 50,
       shadowHeight = 50,
       shadowAnchorX = 4,
       shadowAnchorY = 62
     )
   })
   

2. 简化observeEvent逻辑
   删除observeEvent内部的geo_icon重新定义，改为直接依赖外部的geo_icon，并调整地图渲染逻辑：

   # 初始化地图输出
   output$lfMap <- renderLeaflet({
     req(userFile())
     leaflet(userFile()) %>%
       addProviderTiles(providers$CartoDB.Positron) %>%
       setView(lng = 7.5248, lat = 5.4527, zoom = 3)
   })
   
   # 监听子行业切换和提交按钮，更新地图标记
   observeEvent(c(input$subSector, input$submitButton), {
     req(geo_icon(), userFile())
     leafletProxy("lfMap", data = userFile()) %>%
       clearMarkerClusters() %>%
       clearMarkers() %>%
       addMarkers(
         popup = ~label,
         icon = geo_icon(),
         clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
       )
   })
   

3. 调整UI中的地图输出
   将mainPanel中的uiOutput("lfMap")改为leafletOutput("lfMap")，这样可以使用leafletProxy高效更新，而非重新渲染整个地图组件：

   mainPanel(
     leafletOutput("lfMap")
   )
   

完整修正后的代码 #

# libraries ----
library(tidyverse)    # collection of R packages designed for data science
library(sf)           # Used for creating simple features objects
library(mapview)      # Used for creating interactive maps
library(scales)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(tidygeocoder) # Used for geocoding
# selectInput data
selectInput_data <- readRDS(file = "www/select_item_data.rds")
icon_tbl <- read_rds("www/icon_tbl.rds")

# Define UI for application that draws a histogram
ui <- fluidPage(
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      br(),
      fileInput("upload", "Upload Reference geodata file"),
      hr(),
      shiny::selectInput("datasetLevel", "Select Dataset Level",
                         c("National" = "national",
                           "State" = "state")),
      # Only show this panel if the Agriculture is selected
      shiny::conditionalPanel(
        condition = "input.datasetLevel == 'state'",
        shiny::selectInput(inputId = "mapState",
                           label = "Select State:",
                           choices = c(Choose='', selectInput_data$state_values))
      ),
      shiny::selectInput("sector", "Select Uploaded dataset Sector",
                         c("Administrative Boundaries" = "admin",
                           "Agriculture" = "agriculture",
                           "Commerce" = "commerce",
                           "Education" = "education",
                           "Energy" = "energy",
                           "Health and Safety" = "health_safety",
                           "Population" = "population",
                           "Public Facilities" = "public-facilities",
                           "Religion" = "religion",
                           "Security" = "security",
                           "Water and Sanitation" = "water_sanitation")),
      
      uiOutput("agric_output"),
      uiOutput("commerce_output"),
      uiOutput("edu_output"), 
      uiOutput("energy_output"),
      uiOutput("health_output"), 
      uiOutput("public_output"),
      uiOutput("religion_output"),
      uiOutput("security_output"),
      uiOutput("water_san_output"),
      
      actionButton(inputId = "submitButton",
                   label = "Submit"),
      br()
    ),
    # Show a plot of the generated distribution
    mainPanel(
      leafletOutput("lfMap")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  ## UI section
  output$agric_output <- renderUI({
    req(input$sector == 'agriculture')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Farmland")
    )
  })
  
  output$commerce_output <- renderUI({
    req(input$sector == 'commerce')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Factories/Industrial Sites", "Filling Stations",
        "Market")
    )
  })
  
  output$edu_output <- renderUI({
    req(input$sector == 'education')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Primary Schools", "Private Schools",
        "Public Schools","Secondary Schools",
        "Tertiary Schools")
    )
  })
  
  output$energy_output <- renderUI({
    req(input$sector == 'energy')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Electricity Sub-stations")
    )
  })
  
  output$health_output <- renderUI({
    req(input$sector == 'health_safety')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Ambulance Emergency Services", "Fire Station",
        "Health Care Facilities (Primary, Secondary, Tertiary)",
        "Laboratories","Pharmaceutical Facilities")
    )
  })
  
  output$public_output <- renderUI({
    req(input$sector == 'public-facilities')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Government Buildings", "Post Office",
        "Road")
    )
  })
  
  output$religion_output <- renderUI({
    req(input$sector == 'religion')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Churches", "Mosques")
    )
  })
  
  output$security_output <- renderUI({
    req(input$sector == 'security')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Prison", "Police Stations")
    )
  })
  
  output$water_san_output <- renderUI({
    req(input$sector == 'water_sanitation')
    shiny::selectInput(
      "subSector", "Select Sub Sector",
      c("Dump Sites", "Public Water Points",
        "Enviromental Sites","Water Bodies","Waterway")
    )
  })
  
  userFile <- reactive({
    req(!is.null(input$upload))
    # If no file is selected, don't do anything
    validate(need(input$upload, message = FALSE))
    sf::st_read(input$upload$datapath) |>
      mutate(label=paste("<center>",
                         sep = "<br/>",
                         "<b>",toupper(name),"</b>",
                         "</center>"))
  })
  
  geo_icon <- reactive({
    req(!is.null(input$subSector), input$upload)
    icons(
      iconUrl = icon_tbl |>
        filter(sub_sector == input$subSector) |>
        pull(icon_url),
      iconWidth = 40,
      iconHeight = 40,
      iconAnchorX = 22,
      iconAnchorY = 30,
      shadowWidth = 50,
      shadowHeight = 50,
      shadowAnchorX = 4,
      shadowAnchorY = 62
    )
  })
  
  # 初始化地图
  output$lfMap <- renderLeaflet({
    req(userFile())
    leaflet(userFile()) %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      setView(lng = 7.5248, lat = 5.4527, zoom = 3)
  })
  
  # 监听子行业切换和提交按钮，更新标记图标
  observeEvent(c(input$subSector, input$submitButton), {
    req(geo_icon(), userFile())
    leafletProxy("lfMap", data = userFile()) %>%
      clearMarkerClusters() %>%
      clearMarkers() %>%
      addMarkers(
        popup = ~label,
        icon = geo_icon(),
        clusterOptions = markerClusterOptions(zoomToBoundsOnClick = TRUE)
      )
  })
}

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

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