R 将重复值绘制为 add_sf 中的文本以用于自定义地图

Question

我正在使用带有 sf 对象的 add_sf 来绘制自定义地图。这是 sf 对象 (CdE_Aff2) 的结构，有 53 个多边形（或观测值）。我不知道如何生成这种数据类型的“假”示例，所以这里是我得到的概述：

我想使用分类列“cat”为地图着色，并将真实值“Ptot”显示为打印文本（悬停文本）。我正在使用以下代码：

Colors <- c("<0.5 mm"="#ffffff", "0.5-2 mm"="#E3AC20", "2-4 mm"="#E3C220", "4-6 mm"="#D2CD20", "6-8 mm"="#C2D820", "8-10 mm"="#8CC217", 
          "10-15 mm"="#07B759", "15-20 mm"="#079C63", "20-30 mm"="#0B8C82", "30-40 mm"="#0F82AC", "40-50 mm"="#206DAC", "50-60 mm"="#0F29C2", 
          "60-80 mm"="#072997", ">80 mm"="#C21797")


p <- plot_ly(stroke=I("black")) %>% 
      add_sf(data=CdE_Aff2, color=I("white"), hoverinfo = "none", showlegend=F) %>%
      add_sf(data=CdE_Aff2, color = ~factor(cat, levels=rev(Classes)), colors = Colors,
             text=~Ptot, hoverinfo = "text", hoveron = "fills")
    

我使用“add_sf”两次，因为即使我通过图例删除了一些类别，我也希望多边形轮廓保持不变。两个问题：

1. “Ptot”值会显示多次，而不是只显示一次。在图中，当鼠标位于关联的多边形上时，我只需要一个“10.17”：

如果我使用

 text=~unique(Ptot)

我收到以下错误消息：

Error:
! Tibble columns must have compatible sizes.
* Size 44: Column `text`.
* Size 73979: Columns `x`, `y`, `color`, and `.plotlyGroupIndex`.
i Only values of size one are recycled.
Run `rlang::last_error()` to see where the error occurred.

2. 第二个问题，是否可以显示所有类别的整个图例，即使它们没有出现在数据中？我有 14 个类别，但只显示 7 个，因为我在 CdE_Aff2 中只有 7 个类别。

感谢您的帮助

更新凯特的答案：

我必须删除第一个 add_sf，这并不方便，因为如果我想删除图例中的类别，则多边形会被完全删除，并且它会从周围的所有多边形（和一个 NA）生成值：

Answer 1

使用您的实际数据更新

Ptot

中的每个工具提示都有多个唯一值 - 这就是您所看到的内容的原因。

我在

Classes

中没有

color = ~factor(cat, levels=rev(Classes))

，所以当我测试这个时我使用了

color = ~factor(cat)

。因此，您看到的颜色与您所拥有的颜色不匹配，但就修复而言，这应该不重要。 （您会看到

color

的原始代码已在我的代码中被注释掉。）

如果您只想显示独特的值，这将起作用。之前和之后的几张照片：

包含一个用于修改绘图的函数 (

fixer()

)，以及如何将其添加到绘图中 (

%>% fixer()

)。

library(plotly)

(p <- plot_ly(stroke=I("black")) %>% 
  add_sf(data=CdE_Aff2, color=I("white"), hoverinfo = "none", showlegend=F) %>%
  add_sf(data=CdE_Aff2, color = ~factor(cat),  # color = ~factor(cat, levels=rev(Classes)), 
         colors = Colors,
         text=~Ptot, hoverinfo = "text", hoveron = "fills"))

fixer <- function(plt) {
  plt <- plotly_build(plt)
  lapply(1:length(plt$x$data), function(j) {
    # split so replacements and unique decipherable
    if(any("text" %in% plt$x$data[[j]]$hoverinfo)) {
      message("none not detected for ", j)
      txt <- plt$x$data[[j]]$text %>% strsplit(., split = "\n") %>% 
        unlist() %>% unique()                 # remove repeated values
      plt$x$data[[j]]$text <<- txt            # replace hover content
    }
  })
  plt                                         # return modified plot
}
p %>% fixer()