r - 带图标的 addAwesomeMarkers 函数的传单图例

Question

有没有办法为 addAwesomeMarkers 函数创建具有正确颜色和图标的传单图例。例如，在下面的 map 中，我想创建代码下给出的图例。

library(leaflet)

IconSet <- awesomeIconList(
  ship   = makeAwesomeIcon(icon= 'ship', markerColor = 'green', iconColor = 'white', library = "fa"),
  pirate = makeAwesomeIcon(icon= 'fire', markerColor = 'blue', iconColor = 'white', library = "fa")
)

# Some fake data
df <- sp::SpatialPointsDataFrame(
  cbind(
    (runif(20) - .5) * 10 - 90.620130,  # lng
    (runif(20) - .5) * 3.8 + 25.638077  # lat
  ),
  data.frame(type = factor(
    ifelse(runif(20) > 0.75, "pirate", "ship"),
    c("ship", "pirate")
  ))
)

leaflet(df) %>% addTiles() %>%
  # Select from oceanIcons based on df$type
  addAwesomeMarkers(icon = ~IconSet[type])

衷心感谢您花时间和精力来回答。

Answer 1

有一种方法可以做到这一点，引用 answer ，那就是插入一个 map 控件并用html定义该控件。与其他答案不同，图标使用 css 样式来创建图像(一个元素创建标记形状，另一个元素包含图标、 div 和 span )。图像来自分配给每个元素的 css 类:

• div 设置标记的背景颜色
• 跨度(或者对于 font-awesome， <i> )，设置图标和图标颜色(尽管对于 font-awesome，图标的颜色似乎没有变化)

每个图标库使用不同的类和略有不同的约定。

鉴于其他答案中引用的方法以及图标的属性，我构建了一个显示图标图例的基本函数。

我确实设法构建了一个函数，可以定位来自三个受支持的传单图标库(ion、font-awesome、glyphicon)中的每个图标，但每个库的定位属性略有不同，这仍然会导致较小的定位对我来说问题。为了缩短示例代码，我只包含了 font-awesome 的定位，其他定位遵循类似的方法。如果需要，我可以发布支持这三个功能的函数版本。

该函数仅创建 html，您仍然需要将其放置在控件中(这是基本的，可以轻松添加一些参数来自定义它):

# legend html generator:
markerLegendHTML <- function(IconSet) {

    # container div:
    legendHtml <- "<div style='padding: 10px; padding-bottom: 10px;'><h4 style='padding-top:0; padding-bottom:10px; margin: 0;'> Marker Legend </h4>"

    n <- 1
    # add each icon for font-awesome icons icons:
    for (Icon in IconSet) {
        if (Icon[["library"]] == "fa") {
        legendHtml<- paste0(legendHtml, "<div style='width: auto; height: 45px'>",
                             "<div style='position: relative; display: inline-block; width: 36px; height: 45px' class='awesome-marker-icon-",Icon[["markerColor"]]," awesome-marker'>",
                               "<i style='margin-left: 8px; margin-top: 11px; 'class= 'fa fa-",Icon[["icon"]]," fa-inverse'></i>",
                             "</div>",
                             "<p style='position: relative; top: -20px; display: inline-block; ' >", names(IconSet)[n] ,"</p>",
                           "</div>")    
        }
        n<- n + 1
    }
    paste0(legendHtml, "</div>")
}

并且，加上添加控件(请注意，它从图标列表中获取图例的名称，因此我已根据您的原始内容修改了这些名称，但其他所有内容都应该相同):

library(leaflet)

# legend html generator:
markerLegendHTML <- function(IconSet) {
    # container div:
    legendHtml <- "<div style='padding: 10px; padding-bottom: 10px;'><h4 style='padding-top:0; padding-bottom:10px; margin: 0;'> Marker Legend </h4>"

    n <- 1
    # add each icon for font-awesome icons icons:
    for (Icon in IconSet) {
        if (Icon[["library"]] == "fa") {
        legendHtml<- paste0(legendHtml, "<div style='width: auto; height: 45px'>",
                             "<div style='position: relative; display: inline-block; width: 36px; height: 45px' class='awesome-marker-icon-",Icon[["markerColor"]]," awesome-marker'>",
                               "<i style='margin-left: 8px; margin-top: 11px; 'class= 'fa fa-",Icon[["icon"]]," fa-inverse'></i>",
                             "</div>",
                             "<p style='position: relative; top: -20px; display: inline-block; ' >", names(IconSet)[n] ,"</p>",
                           "</div>")    
        }
        n<- n + 1
    }
    paste0(legendHtml, "</div>")
}

IconSet <- awesomeIconList(
  "Regular Ship"   = makeAwesomeIcon(icon= 'ship', markerColor = 'green', iconColor = 'white', library = "fa"),
  "Pirate Ship" = makeAwesomeIcon(icon= 'fire', markerColor = 'blue', iconColor = 'white', library = "fa")
)

# Some fake data
df <- sp::SpatialPointsDataFrame(
  cbind(
    (runif(20) - .5) * 10 - 90.620130,  # lng
    (runif(20) - .5) * 3.8 + 25.638077  # lat
  ),
  data.frame(type = factor(
    ifelse(runif(20) > 0.75, "Pirate Ship", "Regular Ship"),
    c("Regular Ship", "Pirate Ship")
  ))
)


leaflet(df) %>% addTiles() %>% 
  addAwesomeMarkers(icon = ~IconSet[type]) %>% 
  addControl(html = markerLegendHTML(IconSet = IconSet), position = "bottomleft")