rggplot2tidyversegeom-sfggrough

How to add less roughness to the borders of a map than to the fill of the map

Following these questions and answers (How to shade shapes) and (Unable to replicate this ggplot2 plot), say that I get ggrough (https://xvrdm.github.io/ggrough/index.html) up and running:

#install.packages("devtools") # if you have not installed "devtools" package
#devtools::install_github("xvrdm/ggrough")

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

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"
                   ))
    }
}

I then plot a county map:

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

options <- list(GeomSf=list(fill_style="hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=30))
get_rough_chart(b, options)

This produces:

enter image description here

If I want to 1) keep the roughness setting (of the fill) at 30 and 2) I want to display the borders (and not remove them using the lwd=0 option in geom_sf or something similar), how can I independently control the roughness of the borders? As is, the borders are out of control. I want them to have some amount of roughness so that it looks like they were hand drawn, but only a little. (If this is not possible, how can I include a border that is not affected by ggrough, while the fill is still affected?)

I tried the following:

b <- ggplot(nc) +
    geom_sf(aes(fill = AREA), lwd=0) +
    geom_sf(fill = "transparent", color = "yellow", size = 1)   

options <- list(GeomSf=list(fill_style="hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=30),
                GeomSf=list(fill_style="hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=1))
get_rough_chart(b, options)

My hope was that if I included two GeomSf elements in the list of options, maybe the first would correspond to the first geom_sf (with no borders) and the second—--with roughness set at 1---would correspond to the second geom_sf. But this didn't work:

enter image description here

Solution

  • This method uses two seperate graphs, one for application with ggrough and your customization, one that doesn't use ggrough but introduces a traditional border.

    This requires 2 additional libraries. One turns ggplot2 into html. The other is used to overlay the two plots.

    library(ggiraph)
library(htmltools)

    Since you've a few different plots in your question, here is the exact plotting code I used. I added theme constraints. This sets the panels and text to invisible -- but doesn't remove them. This they need to be there so that the plots can be aligned.

    b <- ggplot(nc) + geom_sf(color = "black") + theme_minimal() +
  theme(panel.grid = element_line(color = NA),  # not resized or removed! (keep spacing)
        axis.text = element_text(color = NA))

    The options were not changed. I will state that I used the first variation (with only one GeomSf).

    After you get_rough_chart, I've got a UDF here that modifies the panel and text fields. It appears that black is used by default and it adds the axis text back into the plot. This removes the text without compromising the spacing.

    (xx <- get_rough_chart(b, options))  # from your question
fixer <- function(ggr) {          # where ggr is the ggrough graph
  nd <- lapply(1:length(ggr$x$data), function(j) {
    if(!is.null(ggr$x$data[[j]]$lengthAdjust)) { # if a text element (axis label)
      ggr$x$data[[j]]$content <- ""              # remove text, but keep spacing
      ggr$x$data[[j]]                            # return modified data element
    } else {
      ggr$x$data[[j]]                            # not text, return orig data
    }
  })
  ggr$x$data <- nd                               # add mod data to graph
  ggr                                            # return mod graph
}
xx2 <- xx %>% fixer()  # modify the plot, to hide text

    Next, create the border only plot. In this plot, the theme is used to remove the white background and set the font size so it matches the defaults in ggrough.

    (g2 <- ggplot(nc) +
    geom_sf(fill = "transparent", color = "black", linewidth = 2) +
    theme_minimal() +
    theme(plot.background = element_rect(fill = NA, color = "transparent"), # no white background
          panel.background = element_rect(fill = NA, color = "transparent"),
          text = element_text(size = 9)))      # text size to match defaults in ggrough

gg <- girafe(ggobj = g2, width_svg = 7, height_svg = 5)  # h/w default w/ ggrough

    Last but not least, assembly.

    browsable(div( # parent div, size matches ggrough's default
  style = css(width = "960px", height = "500px", position = "relative"),
  div(xx2, style = css(display = "block")),                           # ggrough graph
  div(gg, style = css(position = "absolute", top = 0, padding.top = "54.2px", # layer behind
                      width = "610px", height = "500px", z.index = -2))
              )) # size and padding found by trial and error with defaults for graph sizes

    plot

    While the above code does not have fill assigned in geom_sf, if I change that and add fill = "blue", for example, you still have the same results.

    blue plot

    Here's all the code used, all together

    (easier copy + paste)

    # uncommented code is likely unchanged code from your question

library(magrittr)
library(ggplot2)
library(ggrough)
library(sf)
library(htmltools)    # <- I'm new!
library(ggiraph)      # <- I'm new!

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"
               ))
  }
}
nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)

b <- ggplot(nc) + geom_sf(color = "black") + theme_minimal() +
  theme(panel.grid = element_line(color = NA),  # not resized or removed! (keep spacing)
        axis.text = element_text(color = NA))

options <- list(GeomSf = list(fill_style = "hachure", angle = 60, angle_noise = 1,
                              gap_noise = 0, gap = 6, fill_weight = 2, bowing = 5,
                              roughness = 30))

(xx <- get_rough_chart(b, options))  # from your question
fixer <- function(ggr) {          # where ggr is the ggrough graph
  nd <- lapply(1:length(ggr$x$data), function(j) {
    if(!is.null(ggr$x$data[[j]]$lengthAdjust)) { # if a text element (axis label)
      ggr$x$data[[j]]$content <- ""              # remove text, but keep spacing
      ggr$x$data[[j]]                            # return modified data element
    } else {
      ggr$x$data[[j]]                            # not text, return orig data
    }
  })
  ggr$x$data <- nd                               # add mod data to graph
  ggr                                            # return mod graph
}
xx2 <- xx %>% fixer()  # modify the plot, to hide text

(g2 <- ggplot(nc) +
    geom_sf(fill = "transparent", color = "black", linewidth = 2) +
    theme_minimal() +
    theme(plot.background = element_rect(fill = NA, color = "transparent"), # no white background
          panel.background = element_rect(fill = NA, color = "transparent"),
          text = element_text(size = 9)))      # text size to match defaults in ggrough

gg <- girafe(ggobj = g2, width_svg = 7, height_svg = 5)  # h/w default w/ ggrough

browsable(div( # parent div, size matches ggrough's default
  style = css(width = "960px", height = "500px", position = "relative"),
  div(xx2, style = css(display = "block")),                           # ggrough graph
  div(gg, style = css(position = "absolute", top = 0, padding.top = "54.2px", # layer behind
                      width = "610px", height = "500px", z.index = -2))
              )) # size and padding found by trial and error with defaults for graph sizes