用双轴重现 'The Economist' 图表

Question

我试图复制这个
chart来自《经济学人》(左侧)。该图表在左侧 y 轴上绘制了俄罗斯的亿万富翁数量，在右侧绘制了世界其他地区的亿万富翁数量。

创建俄罗斯亿万富翁的图表 ( p1 )。

为其他人创建图表 ( p2 )。

联合 p1和 p2使用 Kohske 的代码进入双 y 轴图表.

数据:( 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

代码:

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)

为了用我选择的字体和颜色格式化文本“俄罗斯数字”和“世界其他地区”，我把它们放在 ggtitle 中。 .但是在步骤 3 中将图表组合在一起后，标题为 p2丢失了，所以这就是我所得到的



我想要实现的是
1. 在我选择的颜色和字体系列中添加文本“世界其他地方”(不是默认的 Helvetica。)
2. 在 x 轴上添加标签 1996。

任何帮助表示赞赏。谢谢!

编辑:添加了数据集和完整代码。
EDIT2:仅供引用，我从这里获得了所有的 Officiana 字体: http://people.oregonstate.edu/~hanshumw/Specie%20I.D./Signage%20Backup/FONT%20Officina%20full/
EDIT3:好的，我终于知道如何通过摆弄网格级别的情节来使其工作

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

把这个块放在 ggsave(...) 之前，这是结果:

Answer 1

这是使用 R 基础图形而不是 ggplot 的解决方案。我没有更改字体系列，因为它只能在安装了相同字体的系统之间移植(我这里没有 Officiana)。添加 family 很容易论据 mtext这样做。

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)