Question

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

在将PDF导出到Adobe 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的答案。基本思想是在不同颜色的自定义文本geoms上进行分层。我不觉得这个答案非常令人满意，因为（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的主题。请注意，**的标题周围会使其变成粗体，而<span>标签带有CSS来为单词着色。

多彩多姿的标题与R.

4 个答案: