Search code examples
rggplot2facet-wrap

Controlling the labels on the primary and secondary axis with facet_wrap()

The following code produces a single plot:

data <- tibble(model = rep(c("model 0", "model I", "model II", "model III", "model IV"),3),
                year = c(rep('2005-2009', 5), rep('2010-2014',5), rep('2015-2017',5)),
                value = c(0.0, 10.4, 30.7, 26.7, 32.2, 0.0, 9.9, 31.0, 26.5, 32.6, 0.0, 19.1, 29.6, 25.6, 25.7),
                unknown = c(rep(30,5), rep(40,5), rep(27,5)),
                region = 'Asia')

# Numeric year
data$year_num <- as.numeric(factor(data$year))
# Labels for primary scale
labels <- levels(factor(data$year))
# Labels for secondary scale
dup_labels <- distinct(data, year, unknown) %>% tibble::deframe()

p1 <- ggplot(data, aes(fill=model, x=value, y = year_num)) + 
  geom_bar(stat='identity', position = position_fill(reverse = TRUE), orientation = "y") +
  scale_fill_grey(start=0.8, end=0.2) +
  theme_bw() +
  ggtitle('Model') +
  xlab('') + ylab('') +
  theme(legend.position="bottom",
        plot.title = element_text(hjust = 0.5),
        legend.title=element_blank(),
        text = element_text(family = "serif")
  ) +
  scale_x_continuous(labels = percent_format(scale = 100)) +
  scale_y_continuous(breaks = seq_along(labels), labels = labels, sec.axis = dup_axis(labels = dup_labels))

p1

enter image description here

Next, I would like to produce several plots with facet_wrap but I have a challenge controlling the labels. I am not quite sure how to iterate the labels for the corresponding plot.

Eg., if I want to plot the following data with facet_wrap(~region, dir = 'v', nrow = 2):

data1 <- tibble(model = rep(c("model 0", "model I", "model II", "model III", "model IV"),3),
                year = c(rep('2005-2009', 5), rep('2010-2014',5), rep('2015-2017',5)),
                value = c(0.0, 10.4, 30.7, 26.7, 32.2, 0.0, 9.9, 31.0, 26.5, 32.6, 0.0, 19.1, 29.6, 25.6, 25.7),
                unknown = c(rep(30,5), rep(40,5), rep(27,5)),
                region = 'Asia')

data2 <- tibble(model = rep(c("model 0", "model I", "model II", "model III", "model IV"),3),
                year = c(rep('2005-2009', 5), rep('2010-2014',5), rep('2015-2017',5)),
                value = c(0.4, 15.0, 25.6, 20.6, 38.3, 1.1, 15, 13, 14.6, 56.9, 0.8, 19.8, 22, 18.8,38.1),
                unknown = c(rep(28,5), rep(35,5), rep(17,5)),
                region = 'Europe')

data <- rbind(data1, data2)

I reckon that I need to have some sort of iteration but I can't really figure it out for this problem.

Solution

  • One option would be the ggh4x package which allows to set a scale for each facet via ggh4x::facetted_pos_scales.

    To this end, make e.g. a list of labels for your dup_axis then add a scale with the respective dup_labels to each facet via ggh4x::facetted_pos_scales:

    library(ggplot2)
library(ggh4x)
library(scales)
library(dplyr)

# Numeric year
data$year_num <- as.numeric(factor(data$year))
# Labels for primary scale
labels <- levels(factor(data$year))
# Make a list of labels for secondary scale by region
dup_labels <- data %>% 
  split(.$region) %>% 
  lapply(function(x) distinct(x, year, unknown) %>% tibble::deframe())

p <- ggplot(data, aes(fill=model, x=value, y = year_num)) + 
  geom_bar(stat='identity', position = position_fill(reverse = TRUE), orientation = "y") +
  scale_fill_grey(start=0.8, end=0.2) +
  theme_bw() +
  ggtitle('Model') +
  xlab('') + ylab('') +
  theme(legend.position="bottom",
        plot.title = element_text(hjust = 0.5),
        legend.title=element_blank(),
        text = element_text(family = "serif")
  ) +
  scale_x_continuous(labels = percent_format(scale = 100)) +
  facet_wrap(~region, nrow = 2, scales = "free_y")

p +
  facetted_pos_scales(
    y = list(
      scale_y_continuous(breaks = seq_along(labels), labels = labels, sec.axis = dup_axis(labels = dup_labels[["Asia"]])), 
      scale_y_continuous(breaks = seq_along(labels), labels = labels, sec.axis = dup_axis(labels = dup_labels[["Europe"]])))
  )

    Or instead of duplicating the code to add the scale for each region you could make use of e.g. lapply:

    p + facetted_pos_scales(y = lapply(dup_labels, function(x) scale_y_continuous(breaks = seq_along(labels), labels = labels, sec.axis = dup_axis(labels = x))))