如何在 plot 线上添加注释以标记离散 x 值之间 y 值的百分比变化

Question

我想可视化线性 model 的结果，其中因变量值变化为离散 x 值的 function。 由于我的 x 值代表连续的天数，我想以百分比来注释每天的变化。 如何在 plot 行中执行此操作？

我的资料

我想测量人们的情绪。 每天我都会收集来自 1000 位不同人的反馈，了解他们的感受。 因此，我得到了情绪的每日平均值，我想看看它如何从一天到另一天变化。

 library(tidyverse) library(emmeans) day_1 <- rnorm(1000, mean = 77, sd = 18) day_2 <- rnorm(1000, mean = 74, sd = 19) day_3 <- rnorm(1000, mean = 80, sd = 5) day_4 <- rnorm(1000, mean = 76, sd = 18) df <- cbind(day_1, day_2, day_3, day_4) %>% as.tibble() %>% gather(., key = day, value = mood, day_1:day_4) %>% mutate_at(vars(day), factor) > df ## # A tibble: 4,000 x 2 ## day mood ## <fct> <dbl> ## 1 day_1 83.9 ## 2 day_1 94.9 ## 3 day_1 104. ## 4 day_1 81.0 ## 5 day_1 61.4 ## 6 day_1 95.1 ## 7 day_1 78.6 ## 8 day_1 108. ## 9 day_1 74.7 ## 10 day_1 79.7 ## #... with 3,990 more rows

拟合和绘图

fit <- lm(formula = mood ~ day, data = df) emmip(fit, ~ day, CIs = TRUE)

---

• 鉴于 plot object 可以使用 ggplot 函数进行编辑，我如何添加天之间的变化，以百分比表示，如下图所示？

• 有没有一种有效的方法来计算变化并将其放在线路的每个部分之上？

Answer 1

以下方法利用ggplot_build() （包含在ggplot2本身中）提取用于创建 plot 的基础数据，然后geom_label()来执行注释本身。

准备工作

如前所述，我们可以使用ggplot_build()从您的数据集中提取数据。

p <- emmip(fit, ~ day, CIs = TRUE)  # save your plot as gg object
plotdata <- ggplot_build(p)$data[[1]]

ggplot_build() function 中发生了很多事情，所以我会解释一下。 我们想要访问结果的data部分，当您这样做时，您将获得用于创建每个图层的数据集。 在 plot 中，您有 3 层：CI 的点、线和条。 原则上，您可以提取其中任何一个，但我选择第一个（ [[1]] ）。 特别是，我们想要访问y值。

为了计算百分比变化，我写了一个小的 function 来为我们使用diff()做这个。 由于diff()不会为第一个索引返回“0”，因此我们必须添加它。 然后我们将该列添加到plotdata ：

percent_change <- function(x) {
  p_change <- (diff(x)/x[1:length(x)-1])*100
  return(c(0,p_change))  # add back the 0 for the first index
}

plotdata$change <- percent_change(plotdata$y)

绘图

现在我们准备好了 plot。 我们将在 plot 中添加一个 label 几何图形， p 。 里面发生了一些事情：

• 过滤以仅使用plotdata$change != 0的plotdata部分。 这是因为我们不希望 label 任何没有变化的点（即第一个点）。

• 我需要在plotdata$change的正值之前添加一个“+”。 ifelse()似乎工作得很好。

• 颜色可以在这里动态改变。 您也可以通过aes() map 它，但我需要创建另一列，因此在这里使用ifelse()将颜色控制为红色或绿色很方便，因为只有两个选项。 您必须在aes()之外执行此操作，否则您只会得到一个图例和默认ggplot2 colors 用于标签“红色”和“绿色”。 没有像我在这里那样创造传奇。

代码和 plot 在这里：

p + geom_label(
  data=subset(plotdata, change != 0),
  aes(x=x, y=y,
    label=paste0(ifelse(
      subset(plotdata, change!=0)$change <0, '','+'),
      round(change, 2),'%')),
  color=ifelse(subset(plotdata, change!=0)$change <0, 'red','green3'),
  nudge_x = -0.3
)