Shiny应用：如何基于滑块输入动态更新Leaflet自定义图标标记？

开发Shiny应用时，希望实现Leaflet地图标记图标随滑块选择的年份动态切换：当选中年份处于startyear与endyear区间内时，标记使用normalIcon；年份在区间外时使用crosshatchedIcon。但当前滑块值变化时，地图标记图标未按预期更新，始终显示同一图标。

简化版代码如下：

library(shiny)
library(leaflet)
normalIcon <- makeIcon(
  iconUrl = "data:image/svg+xml;base64,PHN2ZyB3aWR0aD0nMjAnIGhlaWdodD0nMjAnIHhtbG5zPSciaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmcnPjxjaXJjbGUgY3g9JzEwJyBjeT0nMTAnIHI9JzEwJyBmaWxsPSdibHVlJyAvPjwvc3ZnPg==",
  iconWidth = 20,
  iconHeight = 20
)

crosshatchedIcon <- makeIcon(
  iconUrl = "data:image/svg+xml;base64,PHN2ZyB3aWR0aD0nMjAnIGhlaWdodD0nMjAnIHhtbG5zPSciaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmcnPjxjaXJjbGUgY3g9JzEwJyBjeT0nMTAnIHI9JzEwJyBmaWxsPSdibGFjaycgLz48bGluZSB4MT0nMCcgeTE9JzAnIHgyPScyMCcgeTI9JzIwJyBzdHJva2U9J3doaXRlJyBzdHJva2Utd2lkdGg9JzInIC8+PGxpbmUgeDE9JzEwJyB5MT0nMCcgeDI9JzAnIHkyPScyMCcgc3Ryb2tlPSd3aGl0ZScgc3Ryb2tlLXdpZHRoPScyJyAvPjwvc3ZnPg==",
  iconWidth = 20,
  iconHeight = 20
)

# Sample data for locations
latlong_data <- data.frame(
  Latitude = c(9.26450, 9.36634, 9.40091, 9.32560, 9.15926, 9.32578),
  Longitude = c(41.44080, 41.77454, 41.41324, 41.16377, 42.18467, 42.28893),
  startyear = c(2008, 2004, 2008, 2008, 2018, 2021),
  endyear = c(2016, 2016, 2016, 2012, 2023, 2023)
)

ui <- fluidPage(
  sliderInput("year", "Year", min = 2000, max = 2025, value = 2015, step = 1, sep = ""),
  leafletOutput("map")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = latlong_data,
        lng = ~Longitude,
        lat = ~Latitude,
        icon = normalIcon
      )
  })

  observe({
    selected_year <- input$year
    icons <- ifelse(latlong_data$startyear <= selected_year & latlong_data$endyear >= selected_year, normalIcon, crosshatchedIcon)
    
    leafletProxy("map") %>%
      clearMarkers() %>%
      addMarkers(
        data = latlong_data,
        lng = ~Longitude,
        lat = ~Latitude,
        icon = icons
      )
  })
}

shinyApp(ui = ui, server = server)

ifelse函数无法正确处理makeIcon生成的S3类图标对象，它会将对象简化为向量，导致所有标记最终使用同一个图标（通常是第一个匹配的图标），而不是为每个标记分配对应状态的图标。

要为每个标记单独分配图标，需要生成一个图标对象列表，可以通过lapply遍历逻辑状态来逐个选择图标，再将列表传递给addMarkers的icon参数。

修正后的完整代码如下：

library(shiny)
library(leaflet)
normalIcon <- makeIcon(
  iconUrl = "data:image/svg+xml;base64,PHN2ZyB3aWR0aD0nMjAnIGhlaWdodD0nMjAnIHhtbG5zPSciaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmcnPjxjaXJjbGUgY3g9JzEwJyBjeT0nMTAnIHI9JzEwJyBmaWxsPSdibHVlJyAvPjwvc3ZnPg==",
  iconWidth = 20,
  iconHeight = 20
)

crosshatchedIcon <- makeIcon(
  iconUrl = "data:image/svg+xml;base64,PHN2ZyB3aWR0aD0nMjAnIGhlaWdodD0nMjAnIHhtbG5zPSciaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmcnPjxjaXJjbGUgY3g9JzEwJyBjeT0nMTAnIHI9JzEwJyBmaWxsPSdibGFjaycgLz48bGluZSB4MT0nMCcgeTE9JzAnIHgyPScyMCcgeTI9JzIwJyBzdHJva2U9J3doaXRlJyBzdHJva2Utd2lkdGg9JzInIC8+PGxpbmUgeDE9JzEwJyB5MT0nMCcgeDI9JzAnIHkyPScyMCcgc3Ryb2tlPSd3aGl0ZScgc3Ryb2tlLXdpZHRoPScyJyAvPjwvc3ZnPg==",
  iconWidth = 20,
  iconHeight = 20
)

# Sample data for locations
latlong_data <- data.frame(
  Latitude = c(9.26450, 9.36634, 9.40091, 9.32560, 9.15926, 9.32578),
  Longitude = c(41.44080, 41.77454, 41.41324, 41.16377, 42.18467, 42.28893),
  startyear = c(2008, 2004, 2008, 2008, 2018, 2021),
  endyear = c(2016, 2016, 2016, 2012, 2023, 2023)
)

ui <- fluidPage(
  sliderInput("year", "Year", min = 2000, max = 2025, value = 2015, step = 1, sep = ""),
  leafletOutput("map")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = latlong_data,
        lng = ~Longitude,
        lat = ~Latitude,
        icon = normalIcon
      )
  })

  observe({
    selected_year <- input$year
    # 生成每个标记是否在年份区间内的逻辑向量
    in_range <- latlong_data$startyear <= selected_year & latlong_data$endyear >= selected_year
    # 遍历逻辑向量，为每个标记分配对应图标
    icons <- lapply(in_range, function(x) if(x) normalIcon else crosshatchedIcon)
    
    leafletProxy("map") %>%
      clearMarkers() %>%
      addMarkers(
        data = latlong_data,
        lng = ~Longitude,
        lat = ~Latitude,
        icon = icons
      )
  })
}

shinyApp(ui = ui, server = server)

关键修改点 #

• 先用in_range生成每个标记的状态逻辑向量
• 用lapply遍历逻辑向量，为每个标记单独选择对应的图标，生成图标对象列表
• 将列表传递给addMarkers的icon参数，Leaflet会自动为每个标记匹配对应图标

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