带有 R 的多彩多姿的标题

Question

我想为图表标题中的某些字词添加颜色。我已经能够find some precedent here。具体来说，我希望用撇号（在下面的输出中）包裹的文本与它们各自条形图的颜色相对应。

这是我在将 PDF 导出到 Adob​​e Illustrator 或其他程序之前在 R 中使用标题的程度。

name <- c("Peter", "Gabriel", "Rachel", "Bradley")
age <- c(34, 13, 28, 0.9)
fake_graph <- family[order(family$age, decreasing = F), ]
fake_graph <- within(fake_graph, {
    bar_color = ifelse(fake_graph$name == "Rachel", "blue", "gray")
})

# Plot creation
library(ggplot2)
fake_bar_charts <- ggplot() +
  geom_bar(
    data = fake_graph,
    position = "identity",
    stat = "identity",
    width = 0.75,
    fill = fake_graph$bar_color,
    aes(x = name, y = age)
    ) +
  scale_x_discrete(limits = fake_graph$name) +
  scale_y_continuous(expand = c(0, 0)) +
  coord_flip() +
  theme_minimal()
family <- data.frame(name, age)

# Add title
library(grid)
library(gridExtra)
grid_title <- textGrob(
  label = "I spend more time with 'Rachel' than\nwith 'other family members.'",
  x = unit(0.2, "lines"),
  y = unit(0.1, "lines"),
  hjust = 0, vjust = 0,
  gp = gpar(fontsize = 14, fontface = "bold")
)
gg <- arrangeGrob(fake_bar_charts, top = grid_title)
grid.arrange(gg)

输出：

此示例使用ggplot2 创建条形图以及grid 和gridExtra 用于标题功能，但我愿意使用任何解决方案（最好使用ggplot2 来创建图表本身) 可以为我提供引号中的文本以匹配它们各自的条形图颜色。

本网站上的任何其他解决方案都无法解决这个难题，但我很想在 R 中找到解决方案。

感谢您的帮助！

Answer 1

我写的标签太诚实了。第一个grob 的宽度决定了第二个grob 的x，以此类推。我使用grobTree() 将它们分组。因为gTree 没有自己的大小信息，所以我给arrangeGrob() 一个参数padding 以保留gTree 的空间。

library(grid); library(gridExtra); library(ggplot2)

df <- data.frame(name = c("Rachel", "Peter", "Gabriel","Bradley"), age = c(23, 35, 12, 3))
fake_bar_charts <- ggplot(df, aes(x=name, y=age)) + 
  geom_bar(stat="identity", fill = c(rep("gray50",3), "red")) + coord_flip()

grobs <- grobTree(
  gp = gpar(fontsize = 14, fontface = "bold"), 
  textGrob(label = "I spend more time with '", name = "title1",
           x = unit(0.2, "lines"), y = unit(1.4, "lines"), 
           hjust = 0, vjust = 0),
  textGrob(label = "Rachel", name = "title2",
           x = grobWidth("title1") + unit(0.2, "lines"), y = unit(1.4, "lines"),
           hjust = 0, vjust = 0, gp = gpar(col = "red")),
  textGrob(label = "' than", name = "title3",
           x = grobWidth("title1") + grobWidth("title2") + unit(0.2, "lines"), y = unit(1.4, "lines"),
           hjust = 0, vjust = 0),
  textGrob(label = "with '", name = "title4",
           x = unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0),
  textGrob(label = "other family members", name = "title5",
           x = grobWidth("title4") + unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0, gp = gpar(col = "gray50")),
  textGrob(label = "'.", name = "title6",
           x = grobWidth("title4") + grobWidth("title5") + unit(0.2, "lines"), y = unit(0.1, "lines"),
           hjust = 0, vjust = 0)
)

gg <- arrangeGrob(fake_bar_charts, top=grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)

Answer 2

一个非常简单的方法是使用ggtext

这是通过

实现的

library(ggtext) #remotes::install_github("wilkelab/ggtext")

ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
  geom_point(size = 3) +
  scale_color_manual(
    name = NULL,
    values = c(setosa = "#0072B2", virginica = "#009E73", versicolor = "#D55E00"),
    labels = c(
      setosa = "<i style='color:#0072B2'>I. setosa</i>",
      virginica = "<i style='color:#009E73'>I. virginica</i>",
      versicolor = "<i style='color:#D55E00'>I. versicolor</i>")
  ) +
  labs(
    title = "**Fisher's *Iris* dataset**  
    <span style='font-size:11pt'>Sepal width vs. sepal length for 
    <span style='color:#0072B2;'>setosa</span>, 
    <span style='color:#D55E00;'>versicolor</span>, and
    <span style='color:#009E73;'>virginica</span>
    </span>",
    x = "Sepal length (cm)", y = "Sepal width (cm)"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_markdown(lineheight = 1.1),
    legend.text = element_markdown(size = 11)
  )

Answer 3

这是利用有关how to insert annotations outside of the plot area 的答案的第一次尝试。基本思想是使用不同颜色的自定义文本几何分层。我觉得这个答案不是很令人满意，因为（i）字符的边缘是锯齿状的（多次将文本覆盖在自身上的结果），并且（ii）需要手动指定标题的位置，但是这是一个开始：

library(ggplot2)
library(grid)

# Convenience function to make text    
tt <- function(text, colour, x, y) {
  annotation_custom(
    grob = textGrob(
      label = text, hjust = 0, gp = gpar(col = colour)),
      xmin = x, xmax = x,
      ymin = y, ymax = y
  )   
}

p <- ggplot(mpg, aes(x = class, fill = ifelse(class == "pickup", "a", "b"))) +
  geom_bar() +
  scale_fill_manual(guide = FALSE, values = c("blue", "grey")) + 
  coord_flip() +
  theme(plot.margin = unit(c(4, 3, 3, 2), units = "lines"))
p <- p +
  tt("I spend more time with 'pickup' than\nwith 'other family members.'",
       "grey", 8.5, 0) +
  tt("I spend more time with 'pickup' than\nwith",
       "black", 8.5, 0) +
  tt("I spend more time with 'pickup'\n",
       "blue", 8.5, 0) +
  tt("I spend more time with\n",
       "black", 8.5, 0)
# Code to override clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)

Answer 4

使用ggcharts 和mdthemes 这可以很容易地实现。

name <- c("Peter", "Gabriel", "Rachel", "Bradley")
age <- c(34, 13, 28, 0.9)
family <- data.frame(name, age, stringsAsFactors = FALSE)

title <- paste(
  "**I spend more time with '<span style=color:'#1F77B4'>Rachel</span>' than",
  "with '<span style=color:'lightgray'>other family members</span>'**",
  sep = "<br>"
)

ggcharts::bar_chart(family, name, age, highlight = "Rachel", bar_color = "#1F77B4") +
  ggtitle(title) +
  mdthemes::md_theme_minimal()

ggcharts 中的 bar_chart() 函数默认创建一个水平排序的条形图。使用highlight 参数内置突出显示。

mdthemes 包提供了将文本呈现为 markdown/HTML 的主题。请注意标题周围的** 使其粗体 和带有CSS 的<span> 标记来为单词着色。