Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to shade shapes

Tags:

r

ggplot2

ggrough

Is it possible to use ggrough (https://xvrdm.github.io/ggrough/index.html) to shade shapes created by geom_sf (preferred) or potentially geom_polygon? See this question for a prior question that gives the look of the plot I have in mind and the accompanying answer by Z.Lin that modifies the package to make it compatible with the current version of ggplot2: Unable to replicate this ggplot2 plot.

Here is a MWE of a map created using geom_sf that I would like to shade (each individual county) using 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 

This produces the following:

enter image description here

How can I shade the counties of this map using ggrough or is this not possible? Note that I think that ggrough can handle geom_col, geom_bar, geom_tile, geom_geom_area, geom_ribbon, geom_violin, geom_point, geom_jitter, geom_dotplot, geom_line, and geom_smooth, but I am not sure about geom_sf or geom_polygon; if not, would it be easy to add them in?

***Update Here is another example, taken from 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

This produces:

enter image description here

***End update

(Here is an example, created with ggrough, of how I want the shading of the counties to look: enter image description here )

Here is a failed attempt (again relying on code from Z.Lin's answer here: Unable to replicate this ggplot2 plot):

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)

This produces the error message:

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

***Update

Or with the second example:

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)

Same error.

***End update.

Note also that it is possible to create maps using geom_polygon, so that is of interest as well, though geom_sf is preferred.

like image 617
bill999 Avatar asked Sep 23 '20 15:09

bill999


People also ask

How do beginners learn shading?

To have good pressure control, practice shading from one end of your sketchbook to the other while pressing harder and harder until the values get darker gradually. Another way to practice is to draw a long rectangle and divide it into several squares.


1 Answers

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

Replace parse_rough using trace

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

In the popup window, paste this so that parse_rough will use parse_sf for 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))
}

Create the function 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"
               ))
  }
}

Create the desired plot

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)

enter image description here

like image 126
Paul Avatar answered Sep 30 '22 19:09

Paul