如何为Leaflet地图标记点实现仅对应当前位置的标签？

问题描述 #

我正在使用如下数据框：

df <- structure(list(name = c("name1", "name2", "name3", "name4"), 
    postcode = c("NE6 4AG", "YO12 4HG", "N1 2SR", "CR4 3SR"), 
    type = c("type1", "type1", "type1", "type2"), lat = c(54.9849, 
    54.26435, 51.53963, 51.402), long = c(-1.56043, -0.41642, 
    -0.09786, -0.1743)), row.names = c(NA, -4L), class = c("tbl_df", 
"tbl", "data.frame"))

当前地图上每个位置的标签会显示所有站点的信息，我需要让每个标签仅对应单个站点的信息。使用的脚本如下：

library(leaflet)
library(htmlwidgets)
library(dplyr)
library(tidygeocoder)
library(leaflet.extras)  
library(htmltools)  

# 定义站点类型颜色
site_colors <- c("type1" = "red", "type2" = "blue")

# 定义标记的自定义图标
type1_icon <- makeIcon(
  iconUrl = "https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-red.png",
  iconWidth = 25, iconHeight = 41,
  iconAnchorX = 12, iconAnchorY = 41
)

type2_icon <- makeIcon(
  iconUrl = "https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-blue.png",
  iconWidth = 25, iconHeight = 41,
  iconAnchorX = 12, iconAnchorY = 41
)

# 拆分数据为两个子集
type1df <- df %>% filter(type == "type1")
type2df <- df %>% filter(type == "type2")

# 创建leaflet地图
map <- leaflet() %>%
  addTiles() %>%  # 添加默认OpenStreetMap瓦片
  
  # 添加type1站点的红色标记
  addMarkers(
    data = type1df,
    lng = ~long,
    lat = ~lat,
    icon = type1_icon,
    label = ~htmltools::HTML(
      paste(
        "<strong>", name, "</strong><br>",
        postcode
      )
    ),
    labelOptions = labelOptions(
      noHide = TRUE,  # 让标签始终可见
      direction = "top",
      opacity = 0.8,
      textsize = "12px"
    )
  ) %>%
  
  # 添加type2站点的蓝色标记
  addMarkers(
    data = type2df,
    lng = ~long,
    lat = ~lat,
    icon = type2_icon,
    label = ~htmltools::HTML(
      paste(
        "<strong>", name, "</strong><br>",
        postcode
      )
    ),
    labelOptions = labelOptions(
      noHide = TRUE, 
      direction = "auto",  
      opacity = 0.8,  
      textsize = "12px"  
    )
  ) %>%
  # 添加图例
  addLegend(
    "bottomright",
    colors = c("red", "blue"),
    labels = c("type1", "type2"),
    title = "站点类型"
  )

问题原因 #

问题出在paste函数的行为上：当你在~htmltools::HTML(paste(...))中使用paste时，它会把整列的name和postcode拼接成一个长字符串，导致每个标记的标签都显示所有站点的信息，而不是对应单行的内容。

解决方案 #

以下几种方法都可以解决这个问题：

方法1：替换为paste0逐元素拼接 #

最简单的修改是把paste换成paste0，它会自动按向量的每个元素逐一拼接，生成对应单行的HTML内容：

# 修改type1站点的label部分
label = ~htmltools::HTML(paste0("<strong>", name, "</strong><br>", postcode))

# type2站点的label部分同样修改
label = ~htmltools::HTML(paste0("<strong>", name, "</strong><br>", postcode))

方法2：预先生成标签列 #

在拆分数据时，提前为每个子集生成对应的标签列，后续直接引用该列即可：

# 拆分数据并生成标签列
type1df <- df %>% 
  filter(type == "type1") %>%
  mutate(label_content = htmltools::HTML(paste0("<strong>", name, "</strong><br>", postcode)))

type2df <- df %>% 
  filter(type == "type2") %>%
  mutate(label_content = htmltools::HTML(paste0("<strong>", name, "</strong><br>", postcode)))

# 创建地图时引用预生成的标签列
map <- leaflet() %>%
  addTiles() %>%
  addMarkers(
    data = type1df,
    lng = ~long,
    lat = ~lat,
    icon = type1_icon,
    label = ~label_content,
    labelOptions = labelOptions(
      noHide = TRUE,
      direction = "top",
      opacity = 0.8,
      textsize = "12px"
    )
  ) %>%
  addMarkers(
    data = type2df,
    lng = ~long,
    lat = ~lat,
    icon = type2_icon,
    label = ~label_content,
    labelOptions = labelOptions(
      noHide = TRUE,
      direction = "auto",
      opacity = 0.8,
      textsize = "12px"
    )
  ) %>%
  addLegend(
    "bottomright",
    colors = c("red", "blue"),
    labels = c("type1", "type2"),
    title = "站点类型"
  )

方法3：使用purrr::pmap逐行生成标签 #

如果需要更灵活的控制，可以用purrr包的pmap函数逐行处理数据，生成对应标签：

# 需要先加载purrr包
library(purrr)

# 修改addMarkers中的label参数
addMarkers(
  data = type1df,
  lng = ~long,
  lat = ~lat,
  icon = type1_icon,
  label = ~pmap(list(name, postcode), function(n, p) {
    htmltools::HTML(paste0("<strong>", n, "</strong><br>", p))
  }),
  labelOptions = labelOptions(
    noHide = TRUE,
    direction = "top",
    opacity = 0.8,
    textsize = "12px"
  )
)

内容的提问来源于stack exchange，提问作者Abdul-Kareem Abdul-Rahman