Как растушевать формы

Question

Можно ли использовать ggrough(https://xvrdm.github.io/ggrough/index.html), чтобы затенять формы, созданные geom_sf(предпочтительно) или потенциально geom_polygon? См. Предыдущий вопрос в этом вопросе, который дает представление о графике, который я имею в виду, и сопровождающий ответ Z.Lin, который изменяет пакет, чтобы сделать его совместимым с текущей версией ggplot2: Невозможно воспроизвести этот график ggplot2 .

Вот MWE карты, созданной с использованием, geom_sfкоторую я хотел бы затенять (каждый отдельный округ), используя ggrough:

library(tidyverse)
library(magrittr)
library(ggplot2)
library(ggrough)
library(RColorBrewer)
library(tidycensus)
library(viridis)
#install.packages("devtools") # if you have not installed "devtools" package
#devtools::install_github("xvrdm/ggrough")
library(hrbrthemes)

#get nevada shapefile
counties <- get_acs(
    geography = "county", year = 2018, geometry = TRUE,
    variables = "B19013_001", keep_geo_vars=TRUE
) %>% filter(STATEFP=="32")
counties$GEOID <- as.integer(counties$GEOID)
#############

a <- ggplot() +
    geom_sf(data = counties, aes(fill = estimate)) + 
    scale_fill_viridis(discrete=FALSE, name="", guide=FALSE) +  
    theme_bw() +
    theme(legend.position = c(0.15, .15)) +
    theme(plot.subtitle = element_text(hjust = 0.8, vjust=-10, size=30)) +  
    theme(panel.background = element_rect(fill = 'white')) +
    theme(panel.grid = element_blank(),axis.title = element_blank(),
          axis.text = element_blank(),axis.ticks = element_blank(),
          panel.border = element_blank())+
    theme(legend.position = c(0.25, .15), legend.key.size = unit(2,"line"),
          legend.title=element_text(size=16), 
          legend.text=element_text(size=14), 
          legend.direction = "vertical", 
          legend.box = "horizontal") +
    labs(caption = "")
a 

Это дает следующее:

Как я могу заштриховать округа на этой карте, используя ggroughили это невозможно? Заметьте, я думаю, что с этим ggroughсправится geom_col, geom_bar, geom_tile, geom_geom_area, geom_ribbon, geom_violin, geom_point, geom_jitter, geom_dotplot, geom_line, and geom_smooth, но я не уверен насчет geom_sfили geom_polygon; если нет, было бы легко их добавить?

*** Обновление Вот еще один пример, взятый из https://ggplot2.tidyverse.org/reference/ggsf.html:

nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
b <- ggplot(nc) +
    geom_sf(aes(fill = AREA))
b

Это производит:

*** Конец обновления

(Вот пример, созданный с ggrough, как я хочу затенение графств посмотреть:

)

Вот неудачная попытка (снова полагаясь на код из ответа Z.Lin здесь: невозможно воспроизвести этот график ggplot2 ):

parse_polygons <- function (svg) {
    shape <- "polygon" # was "polyline" in ggrough:::parse_areas
    keys <- NULL
    ggrough:::parse_shape(svg, shape, keys) %>% {
        purrr::map(., 
                   ~purrr::list_modify(.x, 
                                    points = stringr::str_squish(.x$points) %>% 
                                        {stringr::str_glue("M{.}Z")}, 
                                    shape = "path"))
    }
}

trace(ggrough:::parse_rough, edit = TRUE)

# paste the following function into the pop-up window
function (svg, geom) {
    rough_els <- list()
    if (geom %in% c("GeomCol", "GeomBar", "GeomTile", "Background")) {
        rough_els <- append(rough_els, parse_rects(svg))
    }
    if (geom %in% c("GeomSmooth", "Background")) {   # removed GeomArea / GeomViolin from here
        rough_els <- append(rough_els, parse_areas(svg))
    }
    if (geom %in% c("GeomArea", "GeomRibbon", "GeomViolin")) {  # new condition here
        rough_els <- append(rough_els, parse_polygons(svg))
    }
    if (geom %in% c("GeomPoint", "GeomJitter", "GeomDotPlot", "Background")) {
        rough_els <- append(rough_els, parse_circles(svg))
    }
    if (geom %in% c("GeomLine", "GeomSmooth", "Background")) {
        rough_els <- append(rough_els, parse_lines(svg))
    }
    if (geom %in% c("Background")) {
        rough_els <- append(rough_els, parse_texts(svg))
    }
    purrr::map(rough_els, ~purrr::list_modify(.x, geom = geom))
}

options <- list(GeomSf=list(fill_style="hachure", 
                              angle_noise=0.5,
                              gap_noise=0.2,
                              gap=1.5,
                              fill_weight=1))
get_rough_chart(a, options)

Это вызывает сообщение об ошибке:

Error in `*tmp*`[[i]] : subscript out of bounds

***Обновить

Или со вторым примером:

options <- list(GeomSf=list(fill_style="hachure", 
                          angle_noise=0.5,
                          gap_noise=0.2,
                          gap=1.5,
                          fill_weight=1))
get_rough_chart(b, options)

Та же ошибка.

*** Конец обновления.

Также обратите внимание, что можно создавать карты с помощью geom_polygon, так что это тоже интересно, хотя и geom_sfявляется предпочтительным.

Answer 1

library(magrittr)
library(ggplot2)
library(ggrough)

Заменить parse_roughс помощьюtrace

trace(ggrough:::parse_rough, edit=TRUE)

Во всплывающем окне вставьте это, чтобы parse_roughиспользовать parse_sfдля GeomSf.

function (svg, geom) 
{
  rough_els <- list()
  if (geom %in% c("GeomCol", "GeomBar", "GeomTile", 
                  "Background")) {
    rough_els <- append(rough_els, parse_rects(svg))
  }
  if (geom %in% c("GeomArea", "GeomViolin", "GeomSmooth", 
                  "Background")) {
    rough_els <- append(rough_els, parse_areas(svg))
  }
  if (geom %in% c("GeomPoint", "GeomJitter", "GeomDotPlot", 
                  "Background")) {
    rough_els <- append(rough_els, parse_circles(svg))
  }
  if (geom %in% c("GeomLine", "GeomSmooth", "Background")) {
    rough_els <- append(rough_els, parse_lines(svg))
  }
  if (geom %in% c("Background")) {
    rough_els <- append(rough_els, parse_texts(svg))
  }
  if (geom %in% c("GeomSf")) {
    rough_els <- append(rough_els, parse_sf(svg))
  }
  purrr::map(rough_els, ~purrr::list_modify(.x, geom = geom))
}

Создайте функцию parse_sf.

parse_sf <- function (svg) {
  shape <- "path"
  keys <- NULL
  ggrough:::parse_shape(svg, shape, keys) %>% {
    purrr::map(., 
               ~purrr::list_modify(.x, 
                                   points = .x$d, 
                                   shape = "path"
               ))
  }
}

Создайте желаемый сюжет

nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
b <- ggplot(nc) +
  geom_sf(aes(fill = AREA))
b


options <- list(GeomSf=list(fill_style="hachure", 
                            angle_noise=0.5,
                            gap_noise=0.2,
                            gap=1.5,
                            fill_weight=1))
get_rough_chart(b, options)