superponer - Reproducir un gráfico ''The Economist'' con eje doble

superponer graficas en r

Question

Intentaba replicar esta tabla de The Economist (la de la izquierda). El gráfico representa el número de multimillonarios en Rusia en el eje y de la izquierda y el número de multimillonarios en el resto del mundo a la derecha.

1. Crea la tabla para multimillonarios rusos ( p1 ).
2. Crea el cuadro para los demás ( p2 ).
3. Combina p1 y p2 en un gráfico dual del eje y utilizando el código de Kohske .

Datos: (contenido de 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

Código:

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)

Para formatear los textos "Número en Rusia" y "Resto del mundo" con la fuente y el color elegidos, los puse en ggtitle . Pero después de combinar los gráficos juntos en el paso 3, falta el título de p2 , así que esto es todo lo que obtuve

Lo que estoy tratando de lograr es
1. Agregue el texto "Resto del mundo" en una familia de color y fuente de mi elección (no la Helvetica predeterminada).
2. Agregue la etiqueta 1996 en el eje x.

Cualquier ayuda es apreciada. ¡Gracias!

EDITAR: conjunto de datos y código completo agregado.
EDIT2: Solo para tu información, obtuve todas las fuentes Officiana de aquí: http://people.oregonstate.edu/~hanshumw/Specie%20I.D./Signage%20Backup/FONT%20Officina%20full/
EDIT3: Ok, finalmente cómo hacer que funcione al jugar con la trama en el nivel de la red

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

Pon este trozo antes de ggsave(...) , y aquí está el resultado:

Answer 1

Aquí hay una solución que usa gráficos de base R, en lugar de ggplot. No cambié la familia de fuentes, ya que solo es portátil en todos los sistemas con las mismas fuentes instaladas (no tengo Officiana aquí). Es fácil agregar un argumento family a mtext para hacerlo.

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)

Answer 2

Tu código para combinar las tramas no funciona en mi sesión R, así que no puedo ayudarte allí. Pero aquí están las dos preguntas que usted pidió:

. usa ggtitle
2. usa scale_x_continuous
3. Nota: también he cambiado tu ylim a ylim y tus labs al theme(..., axis.title= element_blank(), ...)

p1 <- ggplot(rus, aes(X, Russia)) + geom_line(colour = "#68382C", size = 1.5) + ggtitle("Number in Russia") +
  lims(y= c(0, 200)) + 
  scale_x_continuous(breaks= c(1996, seq(2000,2015,5))) +
  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.title= element_blank(),
    axis.ticks = element_line(colour = ''gray50''),
    plot.title = element_text(hjust=0,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") +
  lims(y= c(0, 2000)) +  scale_x_continuous(breaks= c(1996, seq(2000,2015,5))) +
  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.title= element_blank(),
    axis.ticks = element_blank(),
    plot.title = element_text(hjust = 1, vjust=2.12, colour="#00a4e6", size = 14, family = "ITCOfficinaSans LT Bold"))

Answer 3

Por supuesto, se puede hacer con gplot2 con ayuda de grid y gtable . No intento posicionar las etiquetas del eje en ggplots; más bien, las etiquetas de los ejes se dibujan en su propio grob, y luego se colocan en el tablero.

Esto se basa en el código de aquí , que a su vez se basa en el código de aquí y del paquete cowplot ). (Se requiere un poco más de trabajo para obtener marcas y etiquetas de tic en el diagrama de superposición dibujado con ggplot2 versión 2.1.0. Observe, por ejemplo, que se justifican como en la representación original de The Economist ).

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