Reproduce a 'The Economist' chart with dual axis
Here's a solution using R base graphics, rather than ggplot. I didn't change the font family, as that's only portable across systems with the same fonts installed (I don't have Officiana here). It's easy to add a family argument to mtext to do so.
par(mar = c(3, 3, 3, 3), las = 1)
plot(tmp[,c(1,3)], type = 'n', axes = FALSE, ylim = c(0, 2000))
abline(h = c(0, 500, 1000, 1500, 2000), col = "grey")
points(tmp[,c(1,3)], type = 'l', col = "blue", lwd = 2)
points(x = tmp[,1], y = tmp[,2] * 10, type = 'l', col = "brown", lwd = 2)
axis(side = 4, at = c(0, 500, 1000, 1500, 2000), tick = FALSE,
col.axis = "blue", line = 1, hadj = 1)
axis(side = 2, at = c(0, 500, 1000, 1500, 2000), tick = FALSE,
col.axis = "brown", hadj = 1,
labels = c(0, 50, 100, 150, 200))
axis(side = 1, at = c(1996, 2000, 2005, 2010, 2015), lwd = 0, line = -1,
lwd.ticks = 2, col.ticks = "grey")
mtext("Number in Russia", side = 2, col = "brown", at = 2150, line = 2.5,
adj = 0)
mtext("Rest of World", side = 4, col = "blue", at = 2150, line = 2,
adj = 1)
Of course, it can be done with gplot2 with some help from grid and gtable. I don't try to position the axis labels in the ggplots; rather the axis labels are drawn in their own grob, and then positioned into the gtable.
This draws on code from here, which in turn draws on code from here and from the cowplot package). (It requires a little more work to get nicely positioned tick marks and tick labels in the overlay plot drawn with ggplot2 version 2.1.0. Notice, for instance, they are left justified as in the original The Economist rendering.)
# Data
dat = read.csv(text = ",Russia,World
1996,0,423
1997,4,220
1998,1,221
1999,0,298
2000,0,322
2001,8,530
2002,6,466
2003,17,459
2004,25,562
2005,27,664
2006,33,760
2007,53,893
2008,87,1038
2009,32,761
2010,62,949
2011,101,1109
2012,96,1130
2013,110,1317
2014,111,1535
2015,88,1738", header = TRUE)
rus <- dat[,1:2]
world <- dat[,-2]
# Packages
library(ggplot2)
library(gtable)
library(grid)
# The ggplots
p1 <- ggplot(rus, aes(X, Russia)) +
geom_line(colour = "#68382C", size = 1.5) +
scale_x_continuous("", breaks = c(1996, seq(2000, 2015, 5))) +
scale_y_continuous("", lim = c(0, 200), expand = c(0, 0)) +
theme_bw() +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "gray50", size = 0.5),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(colour = "#68382C", size = 14),
axis.text.x = element_text(size = 14),
axis.ticks = element_line(colour = 'gray50'),
panel.border = element_blank(),
plot.margin = unit(c(40, 20, 80, 20), "pt"))
p2 <- ggplot(world, aes(X, World)) +
geom_line(colour = "#00a4e6", size = 1.5) +
scale_x_continuous("", breaks= c(1996, seq(2000, 2015, 5))) +
scale_y_continuous("", lim = c(0, 2000), expand = c(0, 0)) +
theme_bw() +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
axis.text.y = element_text(colour = "#00a4e6", size = 14),
axis.text.x = element_text(size = 14),
axis.ticks = element_line(colour = 'gray50'),
panel.border = element_blank(),
panel.background = element_rect(fill = "transparent"))
# Get the plot grobs
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
# Get the location of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Overlap panel for second plot on that of the first plot
g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l)
# ggplot contains many labels that are themselves complex grob;
# usually a text grob surrounded by margins.
# When moving the grobs from, say, the left to the right of a plot,
# make sure the margins and the justifications are swapped around.
# The function below does the swapping.
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
hinvert_title_grob <- function(grob){
# Swap the widths
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# Fix the justification
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
# Get the y axis from g2 (axis line, tick marks, and tick mark labels)
index <- which(g2$layout$name == "axis-l") # Which grob
yaxis <- g2$grobs[[index]] # Extract the grob
# yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
# The relevant grobs are contained in axis$children:
# axis$children[[1]] contains the axis line;
# axis$children[[2]] contains the tick marks and tick mark labels.
# Second, swap tick marks and tick mark labels
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# Third, move the tick marks
# Tick mark lengths can change.
# A function to get the original tick mark length
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
plot_theme <- function(p) {
plyr::defaults(p$theme, theme_get())
}
tml <- plot_theme(p1)$axis.ticks.length # Tick mark length
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + tml
# Fourth, swap margins and fix justifications for the tick mark labels
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
# Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks
# Put the transformed yaxis on the right side of g1
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, yaxis, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "axis-r")
# Labels grob
left = textGrob("Number in Russia", x = 0, y = 1, just = c("left", "top"), gp = gpar(fontsize = 14, col = "#68382C"))
right = textGrob("Rest of World", x = 1, y = 1, just = c("right", "top"), gp = gpar(fontsize = 14, col = "#00a4e6"))
labs = gTree("Labs", children = gList(left, right))
# New row in the gtable for labels - immediately above the panel
pos = g1$layout[grepl("panel", g1$layout$name), c('t', 'l')]
height = unit(3, "grobheight", left)
g1 <- gtable_add_rows(g1, height, pos$t-1)
# Put the label in the new row
g1 = gtable_add_grob(g1, labs, t = pos$t-1, l = pos$l-1, r = pos$l+1)
# Remove a column y label
g1 = g1[, -2]
# Grey rectangle
rect = rectGrob(gp = gpar(col = NA, fill = "grey90"))
# Put the grey rectangles into the margin columns and rows
g1 = gtable_add_grob(g1, list(rect, rect), t = 1, b = length(g1$heights), l = c(1, length(g1$widths)))
g1 = gtable_add_grob(g1, list(rect, rect), t = c(1, length(g1$heights)), l = 1, r = length(g1$widths))
# Draw it
grid.newpage()
grid.draw(g1)
