Pomological Colors

Garrick Aden-Buie 2/4/2018

https://img.shields.io/badge/lifecycle-experimental-orange.svg

Pomological Plots

This package provides a ggplot2 theme inspired by the USDA Pomological Watercolors collection and by Aron Atkins’s (@aronatkins) talk on parameterized RMarkdown at rstudio::conf 2018.

Color Palette

The colors for this theme were drawn from many images from the USDA Pomological Watercolors collection, I chose just a few that I thought worked well together for color and fill scales

scales::show_col(ggpomological:::pomological_palette)

and a few colors for the plot background and decoration

scales::show_col(unlist(ggpomological:::pomological_base))

I’ve also included a css file with the complete collection of color samples.

Setup theme and scales

There are two theme-generating functions:

• theme_pomological() sets the plot theme to be representative of the paper and styling of the watercolors and includes a paper-colored background,

• and theme_pomological_nobg() has the same styling, just with a transparent (or white) background.

A handwriting font is needed for the fully authentic pomological look, and I found a few from Google Fonts that fit the bill.

• Homemade Apple
• Amatic SC
• Mr. Bedfort

Alternatively, use something like calligrapher.com to create your own handwriting font!

For color and fill scales, ggpomological provides scale_color_pomological() and scale_fill_pomological().

In the future, I might revisit this package to

1. Increase colors in discrete scale

2. Setup paired color scales. Lots of great color pairs in the extracted colors.

3. Set up continuous scale colors (we’ll see…)

Add paper background!

ggpomological also provides a function named paint_pomological that uses the magick package to add a pomological watercolor paper background and a subtle texture overlay.

Demo!

We’ll need dplyr and ggplot2 (loaded with ggpomological)

library(ggpomological)

## Loading required package: ggplot2

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

Basic iris plot

# Base plot
basic_iris_plot <- ggplot(iris) +
  aes(x = Sepal.Length, y = Sepal.Width, color = Species) +
  geom_point(size = 2)

# Just your standard Iris plot
basic_iris_plot 

# With pomological theme
basic_iris_plot +
  theme_pomological() +
  scale_color_pomological()

# With transparent background
pomological_iris <- basic_iris_plot +
  theme_pomological_nobg() +
  scale_color_pomological()
pomological_iris 

# Painted!
paint_pomological(pomological_iris, res = 110) %>% 
  magick::image_write("Readme_files/figure-gfm/plot-demo-painted.png")

## Warning: Cannot find file ""

Stacked bar chart

stacked_bar_plot <- ggplot(diamonds) +
  aes(price, fill = cut) +
  geom_histogram(binwidth = 850) + 
  xlab('Price (USD)') + 
  ylab('Count') + 
  scale_x_continuous(label = scales::dollar_format()) +
  scale_fill_pomological()

stacked_bar_plot + theme_pomological()

paint_pomological(
  stacked_bar_plot + theme_pomological_nobg(),
  res = 110
) %>% 
  magick::image_write("Readme_files/figure-gfm/plot-bar-chart-painted.png")

## Warning: Cannot find file ""

Density Plot

density_plot <- mtcars %>% 
  mutate(cyl = factor(cyl)) %>% 
  ggplot() +
  aes(mpg, fill = cyl, color = cyl)+
  geom_density(alpha = 0.75) + 
  labs(fill = 'Cylinders', colour = 'Cylinders', x = 'MPG', y = 'Density') +
  scale_color_pomological() +
  scale_fill_pomological()

density_plot + theme_pomological()

paint_pomological(
  density_plot + theme_pomological_nobg(),
  res = 110
) %>% 
  magick::image_write("Readme_files/figure-gfm/plot-density-demo-painted.png")

## Warning: Cannot find file ""

Points and lines

Data from the Texas Housing

big_volume_cities <- txhousing %>% 
  group_by(city) %>% 
  summarize(mean_volume = mean(volume, na.rm = TRUE)) %>% 
  arrange(-mean_volume) %>% 
  top_n(length(ggpomological:::pomological_palette)) %>% 
  pull(city)

## Selecting by mean_volume

full_bar_stack_plot <- txhousing %>% 
  filter(city %in% big_volume_cities) %>% 
  group_by(city, year) %>% 
  summarize(mean_volume = mean(volume, na.rm = TRUE)) %>% 
  ungroup %>% 
  mutate(city = factor(city, big_volume_cities)) %>% 
  ggplot() +
  aes(year, mean_volume, fill = city, group = city) +
  geom_col(position = 'fill', width = 0.9) +
  labs(x = 'City', y = 'Mean Volume', color = 'City') +
  theme(panel.grid.minor.x = element_blank()) +
  scale_fill_pomological()

full_bar_stack_plot + theme_pomological()

paint_pomological(
  full_bar_stack_plot + theme_pomological_nobg(),
  res = 110
) %>% 
  magick::image_write("Readme_files/figure-gfm/plot-full-bar-stack-painted.png")

## Warning: Cannot find file ""

One last plot

(in my handwriting)

ridges_pomological <- ggplot(diamonds) + 
  aes(x = carat, y = clarity, color = clarity, fill = clarity) + 
  ggridges::geom_density_ridges(alpha = 0.75) + 
  theme_pomological_nobg(
    base_family = 'gWriting',
    base_size = 20,
    base_theme = ggridges::theme_ridges()
    ) + 
  scale_fill_pomological() + 
  scale_color_pomological()

paint_pomological(ridges_pomological, res = 110) %>% 
  magick::image_write("Readme_files/figure-gfm/plot-ridges-painted.png")

## Warning: Cannot find file ""

## Picking joint bandwidth of 0.057