如何在ggplot facet wrap标签中使用不同的字体大小?

How to use different font sizes in ggplot facet wrap labels?

我想在 facet wrap 的标签中创建两种不同大小的文本。

例如:

test <- read.csv(paste0(path, "Costello Artvgl2 for Stack.csv"), sep = ";", dec = ",", header = T)

str(test)


test$Wert <- factor(test$Wert, levels = c("one","two","three","four","five","six")) 


test$Sampling.site <- factor(test$Sampling.site, levels = c("Species X Area T","Species Y Area T","Species X Area A","Species Y Area B","Species X Area B","Species Y Area C"))


levels(test$Sampling.site) <-  c("Species X\nTotal catch (n=133)", "Species Y\nTotal catch (n=185)", "Species X\nSampling area A (n=57)", "Species Y\nSampling area B (n=122)",
                             "Species X\nSampling area B (n=76)",  "Species Y\nSampling area C (n=63)")

theme_new <- function(base_size = 12, base_family = base_family){
theme_bw(base_size = base_size) %+replace%
theme(
  axis.text.x =       element_text(size = 8 ),
  axis.text.y =       element_text(size = 8 ),
  axis.title.x =        element_text(size = 12, vjust = 0.01),
  axis.title.y =        element_text(size = 12, vjust = 0.9, angle = 90),

  plot.title =        element_text(size = 10, face = "bold"),

  legend.key=         element_rect(colour= NA, fill =NA, size = 0.5),
  legend.key.size =   unit(1, "lines"),
  legend.text =       element_text(size = 8),
  legend.title =      element_blank(),

  strip.background =  element_rect(fill = NA, colour = NA), 
  strip.text =        element_text(size = 8, face = "bold",hjust = 0.5, vjust = 0.9),

  panel.background =  element_rect(fill = "white"), 
  panel.border =      element_rect(fill = NA, colour="black"), 
  panel.grid.major =  element_blank(),
  panel.grid.minor =  element_blank(),
  panel.margin =      unit(1, "lines")

)
}

ggplot(test, aes(Fi, Pi),group=Wert)+
geom_point(aes(colour = factor(Wert),shape = factor(Wert)),size=3)      +                         
  scale_shape_manual(values=c(20,18,19,15,16,17))+                    
  scale_x_continuous(limits=c(0, 1),breaks=c(0,0.2,0.4,0.6,0.8,1.0))+     
  scale_colour_brewer(type = "qual", palette = "Paired")+
  scale_y_continuous(limits=c(0, 100),breaks=c(0,20,40,60,80,100))+        
  labs(x = "Frequency of occurrence", y = "Prey-specific abundance [%]")+ 
  facet_wrap(~Sampling.site,scales = "free",ncol = 2) +
  theme_new()

有可能实现吗?

下面的解决方案是一个 hack,因为它使用上标(或下标)为 facet 标签的第二行获取较小的字体大小。我不确定如何在不直接操作条带 grobs 的情况下更好地控制标签大小,尽管可能有一种方法可以编写 labeller 函数来完成它。

我们将使用内置的 mtcars 数据框作为示例。首先,我们将添加将同时用于分面和标记的列。我们将按 cyl 分面,但我们希望标签的第一行显示该分面的圆柱体数,第二行显示该分面中的数据点数。为此,我们将在 mtcars 中创建两个新列,称为 Label1Label2,我们将使用它们来创建构面标签的每一行。我们将对这两列进行分面以获得我们想要的图表中的标签。 (Label3 类似于 Label2,但使用下标而不是上标;这仅在您想更改从第二行底部到绘图面板顶部的距离时才有意义。)

Label1Label2是文本字符串,但是它们是表达式的形式,所以我们在创建绘图时可以使用label_parsed来获得更小的下标文本。

library(ggplot2)
library(dplyr)
library(grid)

mtcars.new = mtcars %>% group_by(cyl) %>% 
  summarise(Label1=paste0("bold(Cylinders:~", unique(cyl),")"),
            Label2=paste0("bold(NULL[Count:~", length(cyl),"])"),
            Label3=paste0("bold(NULL^{Count:~", length(cyl),"})")) %>%
  full_join(mtcars)

现在我们可以创建情节了。 Label1Label2 分面给我们两条线。因为我们为 Label2 创建了一个下标表达式,所以当我们使用 label_parsed 标记面时,它会以较小的字体呈现。相对于 Label1,我更希望 Label2 大一点,但是没有办法用这种(hacky)方法来控制它。此外,尽管 element_text 有一个 lineheight 论点,但 ggplot 似乎并不尊重它。因此,我手动重置了条带标签的行高,以减少两个标签之间的 space。

p = ggplot(mtcars.new, aes(wt, mpg)) +
  geom_point() +
  facet_grid(. ~ Label1 + Label2, labeller=label_parsed) +
  theme_bw() +
  theme(strip.background=element_rect(fill=NA, color=NA),
        strip.text=element_text(size=12))

g <- ggplotGrob(p)
g$heights[[3]] = unit(0.5,"lines")

grid.draw(g)

目前正在开发的ggtext包为这个问题提供了更优雅的解决方案。它支持一小组 HTML 标签,可用于设置部分文本标签的样式。

注意:安装开发版的ggtext可能会拉入开发版的ggplot2。

library(tidyverse)
library(ggtext) # remotes::install_github("clauswilke/ggtext")
library(glue)
#> 
#> Attaching package: 'glue'
#> The following object is masked from 'package:dplyr':
#> 
#>     collapse

count(mtcars, cyl)  %>% 
  mutate(
    cyl_lab = as.character(
      glue("Cylinders: {cyl}<br><span style='font-size:9pt'>Count: {n}</span>")
    )
  ) %>%
  full_join(mtcars) %>%
  ggplot(aes(wt, mpg)) +
  geom_point() +
  facet_grid(. ~ cyl_lab) +
  theme_bw(12) +
  theme(strip.background=element_rect(fill=NA, color=NA),
        strip.text=element_markdown(size = 12, lineheight = 1.1))
#> Joining, by = "cyl"

reprex package (v0.3.0)

于 2020-01-07 创建