rggplot2gtable

Reproduce a 'The Economist' chart with dual axis

I was trying to replicate this chart from The Economist (the one on the left). The chart plots the number of billionaires in Russia on the left y-axis and the number of billionaires in rest of the world on the right.

  1. Create the chart for Russian billionaires (p1).
  2. Create the chart for the others (p2).
  3. Combine p1 and p2 into a dual y-axis chart using the code by Kohske.

Data: (content of billionaire.csv)

,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

Code:

library(ggplot2)
library(gtable)
library(grid)
library(extrafont) # for Officiana font
dat <- read.csv("billionaire.csv")
rus <- dat[,1:2]
world <- dat[,-2]

grid.newpage()
p1 <- ggplot(rus, aes(X, Russia)) + geom_line(colour = "#68382C", size = 1.5) + ggtitle("Number in Russia") +
  ylim(0, 200) + labs(x="",y="") +
  theme(#plot.margin = unit(c(2,1,0,0), "cm"),
    panel.grid.minor = element_blank(), 
    panel.grid.major = element_line(color = "gray50", size = 0.5),
    panel.grid.major.x = element_blank(),
    text=element_text(family="ITCOfficinaSans LT Book"),
    axis.text.y = element_text(colour="#68382C", size = 14),
    axis.text.x = element_text(size = 14),
    axis.ticks = element_line(colour = 'gray50'),
    plot.title = element_text(hjust = -0.17, vjust=2.12, colour="#68382C", size = 14, family = "ITCOfficinaSans LT Bold")) 

p2 <- ggplot(world, aes(X, World)) + geom_line(colour = "#00a4e6", size = 1.5) +  #ggtitle("Rest of world") +
  ylim(0, 2000) + labs(x="",y="") +
  theme(#plot.margin = unit(c(2,1,0,0), "cm"),
    panel.grid.minor = element_blank(), 
    panel.grid.major = element_blank(),
    text = element_text(family="ITCOfficinaSans LT Book"),
    axis.text.y = element_text(colour="#00a4e6", size=14),
    axis.text.x = element_text(size=14),
    axis.ticks = element_blank(),
    plot.title = element_text(hjust = 0.2, vjust=2.12, colour="#00a4e6", size = 14, family = "ITCOfficinaSans LT Bold"))

# Combining p1 and p2
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, 
                             pp$l, pp$b, pp$l)

ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)


g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
ggsave("plot.pdf",g, width=5, height=5)

To format the texts "Number in Russia" and "Rest of the world" with my chosen font and color, I put them in ggtitle. But after combining the charts together in step 3 the title of p2 is missing, so this is all I got

enter image description here

What I'm trying to achieve is
1. Add the text "Rest of world" in a color and font family of my choice (not the default Helvetica.)
2. Add the label 1996 on the x-axis.

Any help is appreciated. Thanks!

EDIT: Data set and full code added.
EDIT2: Just FYI, I got all the Officiana fonts from here: http://people.oregonstate.edu/~hanshumw/Specie%20I.D./Signage%20Backup/FONT%20Officina%20full/
EDIT3: Ok I finally how to make it work by fiddling with the plot at the grid level

g$grobs[[8]]$children$GRID.text.526$label <- c("Number in Russia", "Rest of World")
g$grobs[[8]]$children$GRID.text.526$gp$col <- c("#68382C","#00a4e6")
g$grobs[[8]]$children$GRID.text.526$x <- unit(c(-0.175, 0.774), "npc")

Put this chunk before ggsave(...), and here's the result:

Solution

  • 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)

    enter image description here