sec.axis() with a different transformation for each facet

user_5657234 0
Viewed 393

I want to build a plot faceted by region where the y-axis is the number of cases in the region and the 2nd y-axis is the number of cases per 100k population.

Since each region has a different population the transformation would be different for each region.

Can I do that with sec.axis() ?

Basically this, but I want to add a secondary y-axis that shows the number of cases per 100k given that Ontario's population is 12M and Quebec's population is 8M (so divide cases by population then multiply by 100k)

cases <- tibble::tribble(
  ~province, ~date_report, ~avg_cases_last7,
  "Ontario", "2020-08-26",              111,
  "Quebec", "2020-08-26", 89.8571428571429,
  "Ontario", "2020-08-27", 116.857142857143,
  "Quebec", "2020-08-27", 93.4285714285714,
  "Ontario", "2020-08-28", 113.142857142857,
  "Quebec", "2020-08-28", 89.8571428571429,
  "Ontario", "2020-08-29", 118.285714285714,
  "Quebec", "2020-08-29", 90.4285714285714,
  "Ontario", "2020-08-30", 117.714285714286,
  "Quebec", "2020-08-30",               97,
  "Ontario", "2020-08-31", 117.571428571429,
  "Quebec", "2020-08-31", 107.285714285714,
  "Ontario", "2020-09-01", 124.571428571429,
  "Quebec", "2020-09-01", 115.857142857143,
  "Ontario", "2020-09-02", 126.714285714286,
  "Quebec", "2020-09-02", 114.428571428571,
  "Ontario", "2020-09-03", 128.428571428571,
  "Quebec", "2020-09-03", 125.285714285714,
  "Ontario", "2020-09-04", 130.142857142857,
  "Quebec", "2020-09-04", 141.857142857143,
  "Ontario", "2020-09-05", 136.285714285714,
  "Quebec", "2020-09-05", 151.428571428571
) %>%
  mutate(date_report = as.Date(date_report))

ggplot(cases, aes(x= date_report, y = avg_cases_last7)) + 
  geom_line() +
  facet_wrap(~province,  scales = "free")
ggplot2 r
2 Answers

Not sure wether there is an approach to make this work using simple facetting. Instead I would go for using patchwork:

  1. Split your data by province
  2. Make a plot for each province
  3. Glue the plots together using patchwork

My approach below uses a helper function for plotting and makes use of purrr::pmap to loop over the provinces. The helper function takes three arguments, 1. the data for the province, 2. the province population and 3. to mimic the behaviour of facet warp a logical to indicate wether the y-axis should be labelled.

<!-- language-all: lang-r -->


library(ggplot2)
library(dplyr)
library(patchwork)

cases <- tibble::tribble(
  ~province, ~date_report, ~avg_cases_last7,
  "Ontario", "2020-08-26",              111,
  "Quebec", "2020-08-26", 89.8571428571429,
  "Ontario", "2020-08-27", 116.857142857143,
  "Quebec", "2020-08-27", 93.4285714285714,
  "Ontario", "2020-08-28", 113.142857142857,
  "Quebec", "2020-08-28", 89.8571428571429,
  "Ontario", "2020-08-29", 118.285714285714,
  "Quebec", "2020-08-29", 90.4285714285714,
  "Ontario", "2020-08-30", 117.714285714286,
  "Quebec", "2020-08-30",               97,
  "Ontario", "2020-08-31", 117.571428571429,
  "Quebec", "2020-08-31", 107.285714285714,
  "Ontario", "2020-09-01", 124.571428571429,
  "Quebec", "2020-09-01", 115.857142857143,
  "Ontario", "2020-09-02", 126.714285714286,
  "Quebec", "2020-09-02", 114.428571428571,
  "Ontario", "2020-09-03", 128.428571428571,
  "Quebec", "2020-09-03", 125.285714285714,
  "Ontario", "2020-09-04", 130.142857142857,
  "Quebec", "2020-09-04", 141.857142857143,
  "Ontario", "2020-09-05", 136.285714285714,
  "Quebec", "2020-09-05", 151.428571428571
) %>%
  mutate(date_report = as.Date(date_report))

cases_split <- cases %>% 
  split(.$province)

make_plot <- function(d, pop, axis_label) {
  labs <- if (!axis_label) labs(y = NULL)
  name <- if (!axis_label) "cases per 100k"
  
  ggplot(d, aes(x = date_report, y = avg_cases_last7)) + 
    geom_line() +
    scale_y_continuous(sec.axis = sec_axis(trans = ~ . / pop * 1e6, name = name)) +
    facet_wrap(~province,  scales = "free") +
    labs
}

purrr::pmap(list(d = cases_split, pop = list(12 * 1e6, 8 * 1e6), axis_label = c(TRUE, FALSE)), make_plot) %>% 
  patchwork::wrap_plots()

user_129938610

enter image description here

Here is a solution that creates 2 plots and arranges them using gridExtra::grid.arrange.

library(ggplot2)
library(gridExtra)
p1= ggplot() + 
  geom_line(data = cases[cases$province == 'Ontario', ], aes(x= date_report, y = avg_cases_last7)) +
  facet_wrap(~province,  scales = "free")+ 
  scale_y_continuous(sec.axis = sec_axis(
    trans =  ~ . / 12000000*100000))+
  theme(axis.title = element_blank(),
        plot.margin = margin(t = 0, r = 5, b = 0, l = 0))

p2= ggplot() + 
  geom_line(data = cases[cases$province == 'Quebec', ], aes(x= date_report, y = avg_cases_last7)) +
  facet_wrap(~province)+ 
  scale_y_continuous(sec.axis = sec_axis(
    trans =  ~ . / 8000000*100000))+
  theme(axis.title = element_blank(),
        plot.margin = margin(t = 0, r = 0, b = 0, l = 5))

p = grid.arrange(p1, p2, ncol=2,
             left = 'avg_cases_last7', right = 'Number of cases per 100k ?', bottom = 'date_report')

ggsave(p, filename = 'plot.png', device = 'png', width = 6.75, height = 3)
user_77768340
Related