在 R 中的 ggplot2 中的错误栏中添加箭头，使其高于或低于限制

Question

我在 R 中使用 ggplot2，并且仅在误差条高于或低于下图中的 upper_limit/lower_limit 的情况下，尝试在图中的误差条上添加箭头（请参阅限制定义的代码）。我已经玩过 geom_segment 并可以添加箭头，但它们的位置不正确。我之前也遇到过类似的问题，错误栏和点未对齐，但相同的修复，例如，组似乎在这里不起作用（请参阅之前的问题和答案此处。有人对如何解决此问题有任何建议吗？

生成箭头位置不正确的绘图的代码：

# Define custom_colors as a named vector
custom_colors <- c("HR" = "#97D9E3", "OR" = "#A59BEE", "RD" = "#FDB633", "cont" = "#F6A4B7")

custom_shapes <- c("Obs" = 15, "Between-family" = 24, "Within-family" = 25, "1SMR" = 16, "2SMR" = 18)

pd <- position_dodge(width = 1.0)

line_data <- data.frame(
  xintercept = seq(0.5, 10.5, by = 1)  # Adjust this based on the number of outcomes
)

upper_limit <- 3.5
lower_limit <- -2.3
n_methods <- 5
dodge_width <- 1.0

df_upper_arrows <- df_filtered %>%
  filter(UCI > upper_limit) %>%
  mutate(dodged_x = as.numeric(as.factor(Outcome)) + 
                    (as.numeric(Method) - 1.5) * dodge_width / n_methods)

# Subset for arrows below lower limit
df_lower_arrows <- df_filtered %>%
  filter(LCI < lower_limit) %>%
  mutate(dodged_x = as.numeric(as.factor(Outcome)) + 
                    (as.numeric(Method) - 1.5) * dodge_width / n_methods)

# Create the combined plot
p <- ggplot(df_filtered, aes(x = Outcome)) + 
 
  geom_vline(data = line_data, aes(xintercept = xintercept), 
             color = "white", linetype = 1) +
  
  geom_hline(yintercept = 0, color = "#646363", linetype = "dashed") +
  
  # Points for cont and RD on the second y-axis
  geom_point(data = df_filtered,
             aes(y = Effect_estimate, shape = Method, color = effect_type, fill = effect_type),
             size = 3, stroke=0, position = pd) +

  # Confidence intervals for cont and RD on the second y-axis
  geom_errorbar(data = df_filtered,
                aes(ymin = pmax(LCI, lower_limit), ymax = pmin(UCI, upper_limit), color = effect_type, group = interaction(Method, drop=FALSE)),
                width = 0, position = pd, size = 0.5) +
  
# Arrows for points where UCI exceeds the upper limit
  geom_segment(data = df_upper_arrows,
               aes(x = dodged_x, xend = dodged_x, 
                   y = upper_limit, yend = upper_limit + 0.2, 
                   color = effect_type, group = interaction(Method, drop = FALSE)),
               arrow = arrow(length = unit(0.1, "cm"), type = "open"),
               size = 0.5) +

  # Arrows for points where LCI is below the lower limit
  geom_segment(data = df_lower_arrows,
               aes(x = dodged_x, xend = dodged_x, 
                   y = lower_limit, yend = lower_limit - 0.2, 
                   color = effect_type, group = interaction(Method, drop = FALSE)),
               arrow = arrow(length = unit(0.1, "cm"), type = "open"),
               size = 0.5) +
  
  # Customize the theme
  theme_minimal(base_size = 15) +
  theme(panel.background = element_rect(fill = "gray90", color = NA), # Gray background
        panel.grid.major.x = element_blank(),  # No major vertical gridlines
        panel.grid.minor.x = element_blank(), # Optional: Hide minor vertical gridlines
        panel.grid.major.y = element_line(color = "white"), # Keep y major gridlines
        panel.grid.minor.y = element_line(color = "white", linewidth = 0.5),
        legend.position = "right",
        axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(y = "Effect Estimate (OR)", x = "Outcome", color = "Effect Type", fill = "Effect Type", shape = "Method") +
  
  scale_fill_manual(values = custom_colors, na.translate = FALSE, labels = c("cont" = "Continuous")) +  # Use custom colors for effect types
  scale_color_manual(values = custom_colors, na.translate = FALSE, labels = c("cont" = "Continuous")) +  # Use custom colors for effect types
  scale_shape_manual(values = custom_shapes, labels = c("Obs" = "Observational")) + 
  
  # Secondary y-axis for cont and RD
  scale_y_continuous(limits = c(-2.5,3.8), labels = c("0.14", "1", "7.39", "54.60"), sec.axis = sec_axis(trans = ~ ., name = "Effect Estimate (Continuous, RD)")) +

  guides(shape = guide_legend(override.aes = list(fill = "black", stroke = 0)))

# Print the plot
print(p)

下图：

数据集在这里：

Exposure,Outcome,Method,Model,Effect_estimate,LCI,UCI,p_value,units,effect_type,SD
Loneliness,Self harm,Obs,logistic,0.2695129,0.23552845,0.3053514,6.33E-53,yes/no,OR,NA
Loneliness,Self harm,Between-family,logistic,0.1931246,0.01703334,0.3673559,3.00E-02,yes/no,OR,NA
Loneliness,Self harm,Within-family,logistic,0.2278867,0.05307844,0.4048337,1.00E-02,yes/no,OR,NA
Loneliness,Self harm,1SMR,ivreg,0.31,0.08,0.54,7.51E-03,yes/no,RD,NA
Loneliness,Self harm,2SMR,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Suicide attempt,Obs,logistic,0.2764618,0.23044892,0.3242825,8.76E-31,yes/no,OR,NA
Loneliness,Suicide attempt,Between-family,logistic,0.2787536,0.04139269,0.519828,2.00E-02,yes/no,OR,NA
Loneliness,Suicide attempt,Within-family,logistic,0.2671717,0.02530587,0.510545,3.00E-02,yes/no,OR,NA
Loneliness,Suicide attempt,1SMR,ivreg,0.15,-0.00743,0.31,6.00E-02,yes/no,RD,NA
Loneliness,Suicide attempt,2SMR,IVW,0.3838154,0.16435286,0.6009729,5.57E-04,NA,OR,NA
Loneliness,Depression diagnosis,Obs,logistic,0.4048337,0.38738983,0.4199557,0.00E+00,yes/no,OR,NA
Loneliness,Depression diagnosis,Between-family,logistic,0.4248816,0.34830486,0.5010593,4.64E-28,yes/no,OR,NA
Loneliness,Depression diagnosis,Within-family,logistic,0.3521825,0.2764618,0.4265113,8.17E-20,yes/no,OR,NA
Loneliness,Depression diagnosis,1SMR,ivreg,0.35,0.15,0.55,5.18E-04,yes/no,RD,NA
Loneliness,Depression diagnosis,2SMR,IVW,0.3283796,0.15228834,0.50515,2.74E-04,NA,OR,NA
Loneliness,Anxiety diagnosis,Obs,logistic,0.2787536,0.26007139,0.2966652,1.73E-180,yes/no,OR,NA
Loneliness,Anxiety diagnosis,Between-family,logistic,0.3031961,0.21748394,0.3909351,5.56E-12,yes/no,OR,NA
Loneliness,Anxiety diagnosis,Within-family,logistic,0.2278867,0.1430148,0.3138672,1.93E-07,yes/no,OR,NA
Loneliness,Anxiety diagnosis,1SMR,ivreg,0.13,-0.04,0.29,1.30E-01,yes/no,RD,NA
Loneliness,Anxiety diagnosis,2SMR,IVW,0.2810334,-0.07572071,0.6394865,1.20E-01,NA,OR,NA
Loneliness,Depression trait,Obs,linear,0.5815217,0.55706522,0.6032609,0.00E+00,score ranges from 0 to 27,cont,3.68
Loneliness,Depression trait,Between-family,linear,0.6956522,0.60326087,0.7880435,1.20E-48,score ranges from 0 to 27,cont,3.68
Loneliness,Depression trait,Within-family,linear,0.4809783,0.38315217,0.576087,1.39E-22,score ranges from 0 to 27,cont,3.68
Loneliness,Depression trait,1SMR,ivreg,3.5326087,2.07065217,4.9918478,2.16E-06,score ranges from 0 to 27,cont,3.68
Loneliness,Depression trait,2SMR,NA,NA,NA,NA,NA,NA,NA,3.68
Loneliness,Anxiety trait,Obs,linear,0.4705882,0.44705882,0.4941176,0.00E+00,score ranges from 0 to 21,cont,3.4
Loneliness,Anxiety trait,Between-family,linear,0.5735294,0.48235294,0.6676471,2.61E-33,score ranges from 0 to 21,cont,3.4
Loneliness,Anxiety trait,Within-family,linear,0.3735294,0.27647059,0.4676471,2.51E-14,score ranges from 0 to 21,cont,3.4
Loneliness,Anxiety trait,1SMR,ivreg,2.2970588,1.14117647,3.4529412,9.81E-05,score ranges from 0 to 21,cont,3.4
Loneliness,Anxiety trait,2SMR,NA,NA,NA,NA,NA,NA,NA,3.4
Loneliness,Positive affect,Obs,linear,-0.7027027,-0.71621622,-0.6891892,0.00E+00,rating ranges from 1 to 6,cont,0.74
Loneliness,Positive affect,Between-family,linear,-0.7567568,-0.83783784,-0.6891892,5.58E-85,rating ranges from 1 to 6,cont,0.74
Loneliness,Positive affect,Within-family,linear,-0.5945946,-0.67567568,-0.527027,9.56E-52,rating ranges from 1 to 6,cont,0.74
Loneliness,Positive affect,1SMR,ivreg,-2.3783784,-3.24324324,-1.5135135,7.98E-08,rating ranges from 1 to 6,cont,0.74
Loneliness,Positive affect,2SMR,IVW,-0.472973,-0.62162162,-0.3243243,3.37E-10,NA,cont,0.74
Loneliness,Meaning in Life,Obs,linear,-0.5180723,-0.54216867,-0.4939759,0.00E+00,rating ranges from 1 to 5,cont,0.83
Loneliness,Meaning in Life,Between-family,linear,-0.5903614,-0.6746988,-0.5060241,4.59E-40,rating ranges from 1 to 5,cont,0.83
Loneliness,Meaning in Life,Within-family,linear,-0.4096386,-0.4939759,-0.313253,2.67E-19,rating ranges from 1 to 5,cont,0.83
Loneliness,Meaning in Life,1SMR,ivreg,-1.1084337,-2.09638554,-0.1204819,3.00E-02,rating ranges from 1 to 5,cont,0.83
Loneliness,Meaning in Life,2SMR,NA,NA,NA,NA,NA,NA,NA,0.83
Loneliness,Wellbeing spectrum,Obs,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Wellbeing spectrum,Between-family,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Wellbeing spectrum,Within-family,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Wellbeing spectrum,1SMR,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Wellbeing spectrum,2SMR,IVW,-0.28,-0.32,-0.23,4.55E-33,NA,cont,NA
Loneliness,Life satisfaction,Obs,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Life satisfaction,Between-family,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Life satisfaction,Within-family,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Life satisfaction,1SMR,NA,NA,NA,NA,NA,NA,NA,NA
Loneliness,Life satisfaction,2SMR,IVW,-0.47,-0.69,-0.24,4.28E-05,NA,cont,NA

Answer 1

这是一种可能的选项，它仅使用一个

geom_segment

，而不是使用单独的数据框，而是向数据中添加一些新列来绘制分段：

library(tidyverse)

df_filtered <- df_filtered |>
  mutate(
    Method = factor(Method),
    y = case_when(
      UCI > upper_limit ~ LCI,
      LCI < lower_limit ~ UCI,
      .default = NA
    ),
    yend = case_when(
      UCI > upper_limit ~ Inf,
      LCI < lower_limit ~ -Inf,
      .default = NA
    ),
    x = as.numeric(factor(Outcome)) +
      scales::rescale(
        as.numeric(Method),
        # 4 / 5 = (#(Method) - 1) / #(Method)
        to = c(-1, 1) * (dodge_width / 2) * 4 / 5
      )
  )

ggplot(df_filtered, aes(x = Outcome)) +
  geom_vline(
    data = line_data, aes(xintercept = xintercept),
    color = "white", linetype = 1
  ) +
  geom_hline(yintercept = 0, color = "#646363", linetype = "dashed") +
  geom_point(
    aes(
      y = Effect_estimate, shape = Method,
      color = effect_type, fill = effect_type,
      group = Method
    ),
    size = 3, stroke = 0, position = pd, na.rm = TRUE
  ) +
  geom_errorbar(
    aes(
      ymin = LCI,
      ymax = UCI,
      color = effect_type,
      group = Method
    ),
    width = 0, position = pd, size = 0.5, na.rm = TRUE
  ) +
  geom_segment(
    aes(
      x = x, xend = x,
      y = y, yend = yend,
      color = effect_type
    ),
    arrow = arrow(length = unit(.1, "cm"), type = "open"),
    size = 0.5, na.rm = TRUE
  ) +
  theme_minimal(base_size = 15) +
  theme(
    panel.background = element_rect(fill = "gray90", color = NA), # Gray background
    panel.grid.major.x = element_blank(), # No major vertical gridlines
    panel.grid.minor.x = element_blank(), # Optional: Hide minor vertical gridlines
    panel.grid.major.y = element_line(color = "white"), # Keep y major gridlines
    panel.grid.minor.y = element_line(color = "white", linewidth = 0.5),
    legend.position = "right",
    axis.text.x = element_text(angle = 45, hjust = 1)
  ) +
  labs(
    y = "Effect Estimate (OR)", x = "Outcome",
    color = "Effect Type", fill = "Effect Type", shape = "Method"
  ) +
  scale_fill_manual(
    values = custom_colors, na.translate = FALSE,
    labels = c("cont" = "Continuous")
  ) + # Use custom colors for effect types
  scale_color_manual(
    values = custom_colors, na.translate = FALSE,
    labels = c("cont" = "Continuous")
  ) + # Use custom colors for effect types
  scale_shape_manual(
    values = custom_shapes,
    labels = c("Obs" = "Observational")
  ) +
  scale_y_continuous(
    limits = c(-2.5, 3.8), labels = c("0.14", "1", "7.39", "54.60"),
    sec.axis = sec_axis(
      trans = ~.,
      name = "Effect Estimate (Continuous, RD)"
    )
  ) +
  guides(shape = guide_legend(
    override.aes = list(
      fill = "black",
      stroke = 0
    )
  ))