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

Question

我想可视化线性模型的结果，其中因变量值随离散 x 值变化。因为我的 x 值代表连续的几天，所以我想用百分比来注释每天的变化。我怎样才能在线图中做到这一点？

我的数据

我想衡量人们的情绪。每天我都会收集 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)

鉴于可以使用 ggplot 函数编辑绘图对象，我如何添加天数之间的变化，以百分比表示，如下图所示？
有没有一种有效的方法来计算变化并将其放在该行的每个部分之上？

Answer 1

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

准备工作

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

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

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

为了计算百分比变化，我编写了一个使用 diff() 的小函数来为我们执行此操作。由于 diff() 没有 return 第一个索引为“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)

绘图

现在我们准备好剧情了。我们将向图中添加一个标签 geom，p。里面发生了一些事情：

过滤以仅使用 plotdata$change != 0 的 plotdata 部分。这是因为我们不想标记任何没有变化的点（即第一点）。
我需要在 plotdata$change 的正值前添加一个“+”。 ifelse() 在标签美学中似乎工作得很好。
这里可以动态改变颜色。您也可以通过 aes() 映射它，但我需要创建另一列，因此这里使用 ifelse() 来控制颜色为红色或绿色很方便，因为只有两个选项。您必须在 aes() 之外执行此操作，否则您只会获得标签“红色”和“绿色”的图例和默认 ggplot2 颜色。没有像我在这里那样创建图例。

在此处编码和绘图：

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
)

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

How to add annotation over line plot to mark percent change in y-values between discrete x-values

r

ggplot2

lm

emmeans

我的数据

拟合和绘图

准备工作

绘图