Настройте подписи легенды для непрерывных переменных, разделенных на несколько категорий в ggplot2

Я рисую хороплетную карту округов США. Я произвольно создал переменную dumb, которая равномерно распределена между 1 и 100, и разделил ее на 6 категорий, которые хранятся как dumb_quantiles. Затем я сопоставил dumb_quantiles категории со странами, прилегающими к США. Код и результирующий график приведены ниже:

library(sf)
library(tidyverse)
library(RColorBrewer) #for some nice color palettes

# US map downloaded from https://gadm.org/download_country_v3.html

# National border
us0 <- st_read("<Path>\\gadm36_USA_0.shp")
# State border
us1 <- st_read("<Path>\\gadm36_USA_1.shp")
# County border
us2 <- st_read("<Path>\\gadm36_USA_2.shp")

########################### Remove the Great Lakes #############################
# See my post https://stackoverflow.com/questions/59113457/removing-the-great-lakes-from-us-county-level-maps-in-r
# retrieving the name of lakes and excluding them from the sf 
all.names = us2$NAME_2
patterns = c("Lake", "lake")

lakes.name <- unique(grep(paste(patterns, collapse="|"), 
                     all.names, 
                     value=TRUE, ignore.case = TRUE))
#[1] "Lake and Peninsula" "Lake" "Bear Lake" "Lake Michigan" "Lake Hurron" "Lake St. Clair"    
#[7] "Lake Superior" "Lake of the Woods" "Red Lake" "Lake Ontario" "Lake Erie" "Salt Lake"         
#[13] "Green Lake" 

# Pick the Great Lakes and exclude from us2
lakes.name <- lakes.name[c(4, 5, 7, 10, 11)]
`%notin%` <- Negate(`%in%`)
us2 <- us2[us2$NAME_2 %notin% lakes.name, ]
 ######################### Remove the Great Lakes (end)##########################

# Create a continuous variable
us2$dumb <- runif(nrow(us2), 1,100)

# Create labels
# define number of classes
no_classes <- 6

# extract quantiles
quantiles <- us2 %>%
             pull(dumb) %>%
             quantile(probs = seq(0, 1, length.out = no_classes + 1)) %>%
             as.vector() # to remove names of quantiles, so idx below is numeric

# here we create custom labels
labels <- imap_chr(quantiles, function(., idx){
  return(paste0(round(quantiles[idx], 0),
                "–",
                round(quantiles[idx + 1] , 0)
                ))
})

# we need to remove the last label 
# because that would be something like "*** - NA"
labels <- labels[1:length(labels) - 1]

# Here we actually create a new 
# variable on the dataset with the quantiles
us2 <- us2 %>%
       mutate(dumb_quantiles = cut(dumb,
              breaks = quantiles,
              labels = labels,
              include.lowest = T))

# Color palette
pal <- brewer.pal(length(labels), "RdBu")

# Set default theme
theme_map <- function(...) {
    theme_minimal() +
        theme(
            # remove all axes
            axis.line = element_blank(),
            axis.text.x = element_blank(),
            axis.text.y = element_blank(),
            axis.ticks = element_blank(),
            # add a subtle grid
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            legend.justification = c(1, 1),  # top-right of the legend as the
                                             # anchor point
            legend.position = c(1, 0.1) # Place top-right of the legend to
                                        # 0.1 unit above lower-right corner of
                                        # the image
            )
}

# County level
mainland2 <- ggplot(data = us2) +
    geom_sf(aes(fill = dumb_quantiles), size = 0.1, color = "black") +
    coord_sf(crs = st_crs(2163), 
             xlim = c(-2500000, 2500000), 
             ylim = c(-2300000, 730000)) +
    theme_map()

# Final plot across three levels
p <- mainland2 +
    # US state level boundary
    geom_sf(data = us1, fill = NA, size = 0.3, color = "black") +
    coord_sf(crs = st_crs(2163), 
             xlim = c(-2500000, 2500000), 
             ylim = c(-2300000, 730000)) +
    # US national level boundary
    geom_sf(data = us0, fill = NA, size = 0.3, color = "black") +
    coord_sf(crs = st_crs(2163), 
             xlim = c(-2500000, 2500000), 
             ylim = c(-2300000, 730000)) +
    scale_fill_manual(
        values = rev(pal),
        breaks = labels,
        name = "Title here",
        drop = FALSE,
        labels = labels,
        guide = guide_legend(
                direction = "horizontal",
                keyheight = unit(2, units = "mm"),
                keywidth = unit(10 / (length(labels)/2), units = "mm"),
                title.position = "top",
                nrow = 2,
                byrow = T,
                reverse = T # display highest income on top
                #label.position = "bottom"
    )) +
    theme_map() 

Полученный график выглядит следующим образом:  введите описание изображения здесь

Мне нужны некоторые модификации приведенной выше карты.

  1. Округа с dumb ‹10 окрашены в серый цвет, и только округа со значением dumb› = 10 имеют цветовую кодировку в соответствии с их dumb_quantile категорией с использованием палитры RdBu, как указано выше;

  2. В легенде пометьте серые области как ‹10 смертей и обозначьте другие dumb_quantiles категории аналогичным образом, как показано выше.

Иллюстрация желаемой легенды показана ниже:  введите описание изображения здесь

Есть идеи, как можно добиться этих двух модификаций? Спасибо.


person Patrick    schedule 30.11.2019    source источник
comment
Самый простой способ, вероятно, добавить серый цвет в конец вашей палитры pal <- c(brewer.pal(length(labels) - 1, "RdBu"), "grey80")   -  person Richard Telford    schedule 30.11.2019