传单：混合连续和离散的颜色

Question

我在 R 中使用leaflet 创建了一张地图。这是一张美国地图，其多边形为邮政编码级别。我想使用基于某个值的连续调色板为邮政编码着色。我已经按照示例here 进行操作，并使用colorNumeric 函数成功地将每个邮政编码映射为连续颜色，如下所示：

# Create a continuous palette function
library(leaflet)
library(rgdal)
library(dplyr)

# From https://raw.githubusercontent.com/datasets/geo-boundaries-world-110m/master/countries.geojson
countries <- readOGR("json/countries.geojson", "OGRGeoJSON")
map <- leaflet(countries)

pal <- colorNumeric(palette = colorRamp(c('#4575B4', '#D73027', '#FFFFBF'), interpolate="linear"), 
                    domain = countries$gdp_md_est)

map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
            color = ~pal(gdp_md_est))

让这件事变得复杂的是，现在我想使用离散的调色板单独为邮政编码着色（基本上替换以前的颜色）。作为一个简单的例子，我想使用上面的colorNumeric 函数根据平均重量为每个邮政编码着色。然后，如果我出于某种原因想要排除它，我会在我的数据中使用另一个邮政编码级别字段将所有邮政编码的多边形设为黑色，否则它将保持颜色不变。

我发现很难使用leaflet 和colorNumeric 来实现我的地图的连续和离散着色。任何帮助将不胜感激！

Answer 1

由于上面的示例不足以进行演示，因此我决定使用我用于其他传单相关问题的虚拟数据之一。我希望你不要介意。鉴于您所说，您需要在地图中创建两个图层。一个用于连续变量，另一个用于离散变量。这意味着您需要创建两组颜色。如您所用，您希望将colorNumeric() 用于连续变量。您想将 colorFactor() 用于离散变量。在我的示例代码中，我创建了一个名为 group 的新离散变量。完成调色板的创建后，您需要绘制地图。您需要使用addPolygons() 两次。确保您使用group。这将出现在右上角的图层控制按钮中。据我所知，目前我们不能只显示一个图例。我之前遇到过这个问题，并得出结论，我们目前别无选择。我希望这个演示足以让您在任务中取得进展。

library(raster)
library(dplyr)
library(leaflet)

# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)


### Create dummy data
set.seed(111)
mydf <- data.frame(place = unique(UK$NAME_2),
                   value = sample.int(n = 1000, size = n_distinct(UK$NAME_2), replace = TRUE))

### Create a new dummy column for a discrete variable.
mydf <- mutate(mydf, group = cut(value, breaks = c(0, 200, 400, 600, 800, 1000),
                                 labels = c("a", "b", "c", "d", "e"),
                                 include.lowest = TRUE))


### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = mydf$value, na.color = "black")
dispal <- colorFactor("Spectral", domain = mydf$group, na.color = "black")


leaflet() %>% 
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK, group = "continuous",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~conpal(mydf$value),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", mydf$value, "<br>")) %>%
addPolygons(data = UK, group = "discrete",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~dispal(mydf$group),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", mydf$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = mydf$value,
          title = "UK value",
          opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = mydf$group,
          title = "UK group",
          opacity = 0.3)

如果你选择连续变量层，你会看到如下图。

如果您选择离散变量层，您将看到以下地图。

更新

如果您想同时显示连续组和连续组，则需要预先对数据进行子集化，以免多边形重叠。使用上面的UK 和mydf，你可以试试这样。

### Subset data and create two groups. This is something you gotta do
### in your own way given I have no idea of your own data.

con.group <- mydf[1:96, ]
dis.group <- mydf[97:192, ]


### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = c(min(mydf$value), max(mydf$value)), na.color = "black")
dispal <- colorFactor(palette = "Reds", "Spectral", levels = unique(mydf$group), na.color = "black")


### Subset the polygon data as well

con.poly <- subset(UK, NAME_2 %in% con.group$place)
dis.poly <- subset(UK, NAME_2 %in% dis.group$place)

leaflet() %>% 
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = con.poly, group = "continuous",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~conpal(con.group$value),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", con.group$value, "<br>")) %>%
addPolygons(data = dis.poly, group = "discrete",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~dispal(dis.group$group),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Group: ", dis.group$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = con.group$value,
          title = "UK value",
          opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = dis.group$group,
          title = "UK group",
          opacity = 0.3)