传单:混合连续和离散颜色

Leaflet: Mixing continuous and discrete colors

我在 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 函数根据平均重量为每个邮政编码着色。然后我会在我的数据中使用另一个邮政编码级别字段来使所有邮政编码的多边形变黑,如果我出于某种原因想排除它的话,否则它会保留它们已经存在的颜色。

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

由于上面的示例不足以进行演示,我决定使用我用于其他传单相关问题的虚拟数据之一。我希望你不介意。根据您所说的,您需要在地图中创建两个图层。一个用于连续变量,另一个用于离散变量。这意味着您需要创建两组颜色。正如您所使用的,您想要使用 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)

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

如果你选择离散变量层,你会看到如下图。

更新

如果您想同时显示一个连续组和一个连续组,您需要事先对数据进行子集化,这样多边形就不会重叠。使用上面的 UKmydf,你可以尝试这样的事情。

### 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)