如何在绘图区域外的多面 ggplot(具有对数刻度)中添加注释

How can I add an annotation to a faceted ggplot (with a log scale) outside the plot area

我想在绘图区域外的多面 ggplot 中添加一些注释(最好是文本和箭头)。

你说那是什么?难道没有人问过类似的问题 , and 吗?嗯,是。但他们中的 none 试图在 x-axis 下使用对数刻度进行此操作。

@Z.Lin 的 惊人回答除外 — 但那涉及到一个特定的包,我正在寻找一个更通用的解决方案。

乍一看,这似乎是一个非常小众的问题,但对于那些熟悉森林图的人来说,这可能会引起一些兴趣。

首先,一些背景...我有兴趣在出版物中使用森林图展示 coxph 模型的结果。我的目标是获取模型的结果(字面意思是独立的 coxph object)并使用它来生成可定制的输出(必须与风格指南相匹配)并帮助为观众翻译结果这可能不符合风险比的技术细节。因此,注释和方向箭头。

在您开始删除指向 r packages/functions 的链接之前,这些链接可能有助于做到这一点...以下是我迄今为止尝试过的链接:

所以...背景故事不在话下。我已经为下面的森林图创建了自己的框架,我想在下面添加 - 在 x-axis 标签和 x-axis 标题下方的 space 中 - 两个有助于解释的注释结果。我当前的代码与以下问题作斗争:

任何人可能有的任何建议都将不胜感激...我在下面添加了一个可重现的示例。

## LOAD REQUIRED PACKAGES

library(tidyverse)
library(survival)
library(broom)
library(ggforce)
library(ggplot2)

## PREP DATA

model_data <- lung %>%
  mutate(inst_cat = case_when(
    inst %% 2 == 0 ~ 2,
    TRUE ~ 1)) %>%
  mutate(pat.karno_cat = case_when(
    pat.karno < 75 ~ 2,
    TRUE ~ 1)) %>%
  mutate(ph.karno_cat = case_when(
    ph.karno < 75 ~ 2,
    TRUE ~ 1)) %>%
  mutate(wt.loss_cat = case_when(
    wt.loss > 15 ~ 2,
    TRUE ~ 1)) %>%
  mutate(meal.cal_cat = case_when(
    meal.cal > 900 ~ 2,
    TRUE ~ 1))

coxph_model <- coxph(
  Surv(time, status) ~
    sex + 
    inst_cat +
    wt.loss_cat +
    meal.cal_cat +
    pat.karno_cat +
    ph.karno_cat,
  data = model_data)

## PREP DATA

plot_data <- coxph_model %>%
  broom::tidy(
    exponentiate = TRUE, 
    conf.int = TRUE, 
    conf.level = 0.95) %>%
  mutate(stat_sig = case_when(
    p.value < 0.05 ~ "p < 0.05",
    TRUE ~ "N.S.")) %>%
  mutate(group = case_when(
    term == "sex" ~ "gender",
    term == "inst_cat" ~ "site",
    term == "pat.karno_cat" ~ "outcomes",
    term == "ph.karno_cat" ~ "outcomes",
    term == "meal.cal_cat" ~ "outcomes",
    term == "wt.loss_cat" ~ "outcomes"))

## PLOT FOREST PLOT

forest_plot <- plot_data %>%
  ggplot() +
  aes(
    x = estimate,
    y = term,
    colour = stat_sig) +
  geom_vline(
    aes(xintercept = 1),
    linetype = 2
  ) +
  geom_point(
    shape = 15,
    size = 4
  ) +
  geom_linerange(
    xmin = (plot_data$conf.low),
    xmax = (plot_data$conf.high)
  ) +
  scale_colour_manual(
    values = c(
      "N.S." = "black",
      "p < 0.05" = "red")
  ) +
  annotate(
    "text", 
    x = 0.45, 
    y = -0.2, 
    col="red", 
    label = "indicates y",
    ) +
  annotate(
    "text", 
    x = 1.5, 
    y = -0.2, 
    col="red", 
    label = "indicates y",
  ) +
  labs(
    y = "",
    x = "Hazard ratio") +
  coord_trans(x = "log10") +
  scale_x_continuous(
    breaks = scales::log_breaks(n = 7),
    limits = c(0.1,10)) +
  ggforce::facet_col(
    facets = ~group,
    scales = "free_y",
    space = "free"
  ) +
  theme(
    legend.position = "bottom",
    legend.title = element_blank(),
    strip.text = element_text(hjust = 0),
    axis.title.x = element_text(margin = margin(t = 25, r = 0, b = 0, l = 0))
  )

reprex package (v2.0.1)

于 2022-05-10 创建

我想我会在这里使用 annotation_custom。这需要标准 coord_cartesianclip = 'off',但应该很容易 re-jig 你的 x 轴使用 scale_x_log10

plot_data %>%
  ggplot() +
  aes(
    x = estimate,
    y = term,
    colour = stat_sig) +
  geom_vline(
    aes(xintercept = 1),
    linetype = 2
  ) +
  geom_point(
    shape = 15,
    size = 4
  ) +
  geom_linerange(
    xmin = (log10(plot_data$conf.low)),
    xmax = (log10(plot_data$conf.high))
  ) +
  scale_colour_manual(
    values = c(
      "N.S." = "black",
      "p < 0.05" = "red")
  ) +
  annotation_custom(
    grid::textGrob( 
    x = unit(0.4, 'npc'),
    y = unit(-7.5, 'mm'),
    label = "indicates yada",
    gp = grid::gpar(col = 'red', vjust = 0.5, hjust = 0.5))
  ) +
  annotation_custom(
    grid::textGrob( 
      x = unit(0.6, 'npc'),
      y = unit(-7.5, 'mm'),
      label = "indicates bada",
      gp = grid::gpar(col = 'blue', vjust = 0.5, hjust = 0.5))
  ) +
  annotation_custom(
    grid::linesGrob( 
      x = unit(c(0.49, 0.25), 'npc'),
      y = unit(c(-10, -10), 'mm'),
      arrow = arrow(length = unit(3, 'mm')),
      gp = grid::gpar(col = 'red'))
  ) +
  annotation_custom(
    grid::linesGrob( 
      x = unit(c(0.51, 0.75), 'npc'),
      y = unit(c(-10, -10), 'mm'),
      arrow = arrow(length = unit(3, 'mm')),
      gp = grid::gpar(col = 'blue'))
  ) +
  labs(
    y = "",
    x = "Hazard ratio") +
  scale_x_log10(
    breaks = c(0.1, 0.3, 1, 3, 10),
    limits = c(0.1,10)) +
  ggforce::facet_col(
    facets = ~group,
    scales = "free_y",
    space = "free"
  ) +
  coord_cartesian(clip = 'off') +
  theme(
    legend.position = "bottom",
    legend.title = element_blank(),
    strip.text = element_text(hjust = 0),
    axis.title.x = element_text(margin = margin(t = 25, r = 0, b = 0, l = 0)),
    panel.spacing.y = (unit(15, 'mm'))
  )