Cómo sombrear formas

Question

¿Es posible usar ggrough(https://xvrdm.github.io/ggrough/index.html) para sombrear formas creadas por geom_sf(preferido) o potencialmente geom_polygon? Vea esta pregunta para una pregunta anterior que da el aspecto de la trama que tengo en mente y la respuesta que la acompaña Z.Lin que modifica el paquete para hacerlo compatible con la versión actual de ggplot2: No se puede replicar esta trama ggplot2 .

Aquí hay un MWE de un mapa creado usando el geom_sfque me gustaría sombrear (cada condado individual) usando 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 

Esto produce lo siguiente:

¿Cómo puedo sombrear los condados de este mapa usando ggrougho no es posible? Tenga en cuenta que creo que ggroughpuede manejar geom_col, geom_bar, geom_tile, geom_geom_area, geom_ribbon, geom_violin, geom_point, geom_jitter, geom_dotplot, geom_line, and geom_smooth, pero no estoy seguro de geom_sfo geom_polygon; si no, ¿sería fácil agregarlos?

*** Actualización Aquí hay otro ejemplo, tomado de 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

Esto produce:

*** Finalizar actualización

(Aquí está un ejemplo, creada con ggrough, de cómo quiero que el sombreado de los condados a mirar:

)

Aquí hay un intento fallido (nuevamente confiando en el código de la respuesta de Z Lin aquí: No se puede replicar este gráfico 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)

Esto produce el mensaje de error:

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

***Actualizar

O con el segundo ejemplo:

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)

Mismo error.

*** Finalizar actualización.

Tenga en cuenta también que es posible crear mapas utilizando geom_polygon, por lo que también es interesante, aunque geom_sfse prefiere.

Answer 1

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

Reemplazar parse_roughusandotrace

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

En la ventana emergente, pegue esto para que parse_roughse use parse_sfpara 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))
}

Crea la función 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"
               ))
  }
}

Crea la trama deseada

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)