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

Question

我使用leafletR 创建了一张地图。它是美国的地图，多边形是邮政编码级别。我想使用基于某个值的连续调色板为邮政编码着色。我已按照此处的示例进行操作，并使用如下函数成功地将每个邮政编码映射为连续颜色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)