R-ggplot2-当x轴为因子变量时，如果geom_errorbar超出限制，则添加箭头

当误差超过某个极限时，我想用geom_段将误差条替换为箭头。我发现以前的一篇文章解决了这个问题：

代码运行良好，只是我的x轴是一个因子变量，而不是一个数值变量。在geom_段语句中使用position_dodge可使箭头从正确的位置开始，但不会更改终点（xend）和所有箭头都指向x轴上的一个中心点，而不是从原点笔直向上。

不是将x轴重新编码为数字（我将使用此代码创建许多具有x轴值范围的绘图，最后一个数值始终以“+”）结尾，是否有方法在geom_段内更正此问题

使用的代码：

data$OR.95U_u = ifelse(data$OR.95U > 10, 10 , NA)

ggplot(data, aes(x = numAlleles, y = OR, fill = Outcome)) + 
  geom_bar(position = position_dodge(.5), stat = "identity", width = .4, color = "black") + geom_hline(yintercept = 1, linetype = "dashed", color = "black") + 
  ylim(0,10) + geom_errorbar(aes(ymin=OR.95L, ymax=OR.95U), width=.2,position=position_dodge(.5)) +
  theme(legend.key = element_blank(), text = element_text(size = 11.5), legend.title = element_blank()) + 
  labs(x = "Number of rare alleles") +
  scale_fill_manual(values=c("chocolate1","coral1", "red2", "darkred")) + 
  geom_segment(aes(x = numAlleles, xend = numAlleles, y = OR, yend = OR.95U_u), position = position_dodge(.5), arrow = arrow(length = unit(0.3, "cm")))

结果数字

---

好的，在调查了一点之后，我没有找到一个干净的方法来做这件事，因为

位置\u dodge

似乎只更改x aes，而不更改xend aes<代码>位置推送在这里也不起作用，因为它同时移动所有箭头。 所以我用了一种肮脏的方式来做这件事。我们只需要为

geom\u段创建一个具有所需xend位置的新变量

。我尝试了一种半自动化的方法，可以处理任意级别的着色变量，还创建了一个可重复使用的数据集，因为我相信比我有更多知识的人可以大大改进这一点。 代码中有内联注释，用于解释以下步骤：

library(tidyverse)

# dummy data (tried to replicate your plot data more or less accurately)
df <- tibble(
  numAlleles = rep(c("1", "2+"), each = 4),
  Outcome = rep(LETTERS[1:4], 2),
  OR = c(1.4, 1.5, 1.45, 2.3, 3.8, 4.2, 4.0, 1.55),
  OR.95U = c(1.9,2.1,1.9,3.8,12,12,12,12),
  OR.95L = c(0.9, 0.9, 0.9, 0.8, NA, NA,NA,NA)
) %>%
  mutate(
    OR.95U_u = if_else(OR.95U > 10, 10, NA_real_)
  )

# as it seems that position_dodge in a geom_segment only "dodge" the x aes and
# not the xend aes, we need to supply a custom xend. Also, we need to try
# to automatize the position, for more classes or different dodge widths.
# To do that, lets start with some parameters:
# position_dodge width
position_dodge_width <- 0.5
# number of bars per x axis class
bars_per_class <- length(unique(df$Outcome))
# total space available per class. In discrete vars, this is 1 au (arbitrary unit)
# for each class, but position_dodge only use the fraction of that unit
# indicated in the width parameter, so we need to calculate the real
# space available:
total_space_available <- 1 * position_dodge_width
# now we calculate the real bar width used by ggplot in these au, dividing the
# space available by the number of bars to plot for each class
bar_width_real <- (total_space_available / bars_per_class)
# position_dodge with discrete variables place bars to the left and to the right of the
# class au value, so we need to know when to place the xend to the left or
# to the right. Also, the number of bars has to be taken in to account, as
# in odd number of bars, one is located on the exact au value
if (bars_per_class%%2 == 0) {
  # we need an offset, as bars are wider than arrows, and we want them in the
  # middle of the bar
  offset_segment <- bar_width_real / 2
  # offset modifier to know when to substract or add the modifier
  offset_modifier <- c(rep(-1, bars_per_class%/%2), rep(1, bars_per_class%/%2))
  # we also need to know how meny bars to the left and how many to the right,
  # but, the first bar of each side is already taken in account with the offset,
  # so the bar modifier has to have one bar less for each side
  bar_width_modifier <- c(seq((bars_per_class%/%2-1), 0), seq(0, (bars_per_class%/%2-1)))
} else {
  # when odd number of columns, the offset is the same as the bar width
  offset_segment <- bar_width_real
  # and the modifiers have to have a middle zero value for the middle bar
  offset_modifier <- c(rep(-1, bars_per_class%/%2), 0, rep(1, bars_per_class%/%2))
  bar_width_modifier <- c(seq((bars_per_class%/%2-1), 0), 0, seq(0, (bars_per_class%/%2-1)))
}

# finally we create the vector of xend values needed:
df %>%
  mutate(
    numAlleles_u = as.numeric(as.factor(numAlleles)) + offset_modifier*(offset_segment + (bar_width_modifier*bar_width_real))
  )

ggplot(df, aes(x = numAlleles, y = OR, fill = Outcome)) + 
  geom_bar(
    position = position_dodge(position_dodge_width), stat = "identity",
    width = 0.4, color = "black"
  ) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "black") +
  ylim(0,10) +
  geom_errorbar(
    aes(ymin=OR.95L, ymax=OR.95U), width=.2,position=position_dodge(position_dodge_width)
  ) +
  theme(
    legend.key = element_blank(), text = element_text(size = 11.5),
    legend.title = element_blank()
  ) + 
  labs(x = "Number of rare alleles") +
  scale_fill_manual(values=c("chocolate1","coral1", "red2", "darkred")) + 
  geom_segment(
    aes(x = numAlleles, xend = numAlleles_u, y = OR, yend = OR.95U_u),
    position = position_dodge(position_dodge_width), arrow = arrow(length = unit(0.3, "cm"))
  )

库（tidyverse）
#虚拟数据（试图或多或少准确地复制绘图数据）
df%
变异(
OR.95U_=如果（OR.95U>10，10，不真实）
)
#因为在geom_段中的位置_道奇似乎只“道奇”x aes和
#不是xend aes，我们需要提供定制的xend。此外，我们需要尝试
#使位置自动化，用于更多等级或不同减淡宽度。
#为此，让我们从一些参数开始：
#位置减淡宽度
位置道奇宽度这是个很棒的数字。你为什么要修改？哈哈，谢谢你…箭头最好是直向上，而不是指向一个中心点。你试过
位置道奇（.5，保留='single'）
？谢谢你的建议。我刚试过，箭头指向同一个地方，但现在都来自“结果A”栏的最左侧…所以不幸的是，没有起作用。请提供一个可复制的示例，并提供数据。您可以生成数据，不必提供实际的数据集。此外，我不知道
position\u dodge
与
xend
的行为是否是设计的意图，或者是一个bug，也许值得在ggplot2 github存储库中提交一个bug询问，并报告失败的代码。这非常有效，非常感谢你在这方面的帮助！我真的很感激这一点，这是一个很好的方法来提交一个bug，但奇怪的是，道奇只改变x而不是xend，这将是一个简单得多的任务！
df_three_bars <- df %>% filter(Outcome != 'D')
bars_per_class <- length(unique(df_three_bars$Outcome))
total_space_available <- 1 * position_dodge_width
bar_width_real <- (total_space_available / bars_per_class)
if (bars_per_class%%2 == 0) {
  offset_segment <- bar_width_real / 2
  offset_modifier <- c(rep(-1, bars_per_class%/%2), rep(1, bars_per_class%/%2))
  bar_width_modifier <- c(seq((bars_per_class%/%2-1), 0), seq(0, (bars_per_class%/%2-1)))
} else {
  offset_segment <- bar_width_real
  offset_modifier <- c(rep(-1, bars_per_class%/%2), 0, rep(1, bars_per_class%/%2))
  bar_width_modifier <- c(seq((bars_per_class%/%2-1), 0), 0, seq(0, (bars_per_class%/%2-1)))
}
df_three_bars <- df_three_bars %>%
  mutate(
    numAlleles_u = as.numeric(as.factor(numAlleles)) + offset_modifier*(offset_segment + (bar_width_modifier*bar_width_real))
  )

ggplot(df_three_bars, aes(x = numAlleles, y = OR, fill = Outcome)) + 
  geom_bar(
    position = position_dodge(position_dodge_width), stat = "identity",
    width = 0.4, color = "black"
  ) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "black") +
  ylim(0,10) +
  geom_errorbar(
    aes(ymin=OR.95L, ymax=OR.95U), width=.2,position=position_dodge(position_dodge_width)
  ) +
  theme(
    legend.key = element_blank(), text = element_text(size = 11.5),
    legend.title = element_blank()
  ) + 
  labs(x = "Number of rare alleles") +
  scale_fill_manual(values=c("chocolate1","coral1", "red2", "darkred")) + 
  geom_segment(
    aes(x = numAlleles, xend = numAlleles_u, y = OR, yend = OR.95U_u),
    position = position_dodge(position_dodge_width), arrow = arrow(length = unit(0.3, "cm"))
  )