ggplot2: цветные отдельные слова в заголовке

Недавно я увидел линейную диаграмму в Economist, где заголовок имел цветные слова в соответствии с цветами групп, используемых в линейной диаграмме. Мне было интересно, как это сделать с объектом ggplot2. Вот некоторый код, чтобы сделать линейную диаграмму со всем, как в статье, связанной с econimist, за исключением цветных слов в названии. Внизу я показываю желаемый результат.

Этот вопрос касается не теоретических способов отображения этой информации (например, прямой маркировки или легенды), а скорее о раскраске отдельных слов в заголовках.

data <- data.frame(
    group = rep(c('affluence', 'poverty'), each = 6),
    year = rep(c(1970, 1980, 1990, 2000, 2010, 2012), 2),  
    concentration = c(.125, .12, .14, .13, .145, .146, .068, .09, .125, .119, .13, .135)
)

library(ggplot2)

ggplot(data, aes(year, concentration, color = group)) +
    geom_line(size = 1.5) +
    geom_point(size = 4) +
    scale_y_continuous(limits = c(0, .15)) +
    labs(
        x = NULL, y = NULL, 
        title = 'Concentration of affluence and poverty nationwide'
    ) +
    theme_minimal() +
    theme(
        legend.position = 'none'
    ) +
    scale_color_manual(values = c('#EEB422', '#238E68'))

enter image description here

Ответы

Ответ 1

Это решение основано на отображении текста под графиком, созданным ggplot2, и раскрашивать части заголовка в сюжете (кредиты для участников там!).

Используя phantom заполнители для текста, мы избегаем (большую часть) жесткого кодирования позиций.

# create text grobs, one for each color
t1 <- textGrob(expression("Concentration of " * phantom(bold("affluence")) * "and" * phantom(bold("poverty")) * " nationwide"),
                 x = 0.5, y = 1.1, gp = gpar(col = "black"))

t2 <- textGrob(expression(phantom("Concentration of ") * bold("affluence") * phantom(" and poverty nationwide")),
                 x = 0.5, y = 1.1, gp = gpar(col = "#EEB422"))

t3 <- textGrob(expression(phantom("Concentration of affluence and ") * bold("poverty") * phantom(" nationwide")),
                 x = 0.5, y = 1.1, gp = gpar(col = "#238E68"))


# plot and add grobs with annotation_custom
p <- ggplot(data, aes(year, concentration, color = group)) +
  geom_line(size = 1.5) +
  geom_point(size = 4) +
  scale_y_continuous(limits = c(0, .15)) +
  labs(x = NULL, y = NULL) +
  theme_minimal() +
  theme(legend.position = 'none',
        # add some extra margin on top
        plot.margin = unit(c(4, 1, 1, 1), "lines")) +
  scale_color_manual(values = c("#EEB422", "#238E68")) +
  annotation_custom(grobTree(t1, t2, t3))

# create gtable and remove clipping
g <- ggplot_gtable(ggplot_build(p))
g$layout$clip[g$layout$name == "panel"] <- "off"

# re-draw
grid.draw(g)

enter image description here

С большим количеством цветных слов создание другого expression должно выполняться более программно. См. Например, приятную функцию multiTitle в аналогичном вопросе для base сюжета: название: слова разных цветов? , что должно быть полезно и в ggplot.

Ответ 2

Несколько громоздкое решение с annotation_custom:

ggplot(dat, aes(year, concentration, color = group)) +
  geom_line(size = 1.5) +
  geom_point(size = 4) +
  scale_y_continuous(limits = c(0, 0.16)) +
  labs(x = NULL, y = NULL, title = ' ') +
  theme_minimal() +
  theme(legend.position = 'none') +
  scale_color_manual(values = c('#EEB422', '#238E68')) +
  annotation_custom(textGrob('Concentration of', gp = gpar(col = 'black')), 
                    xmin = 1972, xmax = 1972, ymin = 0.165, ymax = 0.165) +
  annotation_custom(textGrob('affluence', gp = gpar(col = '#EEB422', fontface = 'bold')), 
                    xmin = 1975.7, xmax = 1975.7, ymin = 0.165, ymax = 0.165) +
  annotation_custom(textGrob(' and ', gp = gpar(col = 'black')), 
                    xmin = 1977.65, xmax = 1977.65, ymin = 0.165, ymax = 0.165) +
  annotation_custom(textGrob('poverty', gp = gpar(col = '#238E68', fontface = 'bold')), 
                    xmin = 1979.35, xmax = 1979.35, ymin = 0.165, ymax = 0.165) +
  annotation_custom(textGrob('nationwide', gp = gpar(col = 'black')), 
                    xmin = 1982, xmax = 1982, ymin = 0.165, ymax = 0.165)

который дает:

enter image description here

Основным недостатком этого подхода является то, что он требует много усилий с параметрами, чтобы получить слова названия на правильных местах.