在R中创建含插值的5%间隔分组点图的技术求助

数据集 #

id power percent_power    relVO2   group
1  AC12-PRD-C1    25      21.73913  8.797619     CAD
2  AC12-PRD-C1    40      34.78261  9.758929     CAD
3  AC12-PRD-C1    55      47.82609 11.324405     CAD
4  AC12-PRD-C1    70      60.86957 12.800595     CAD
5  AC12-PRD-C1    85      73.91304 14.273810     CAD
6  AC12-PRD-C1   100      86.95652 16.020833     CAD
7  AC12-PRD-C1   115     100.00000 17.830357     CAD
8  AL13-PRD-C1    25      19.23077  7.733918     CAD
9  AL13-PRD-C1    40      30.76923  8.754386     CAD
10 AL13-PRD-C1    55      42.30769 10.000000     CAD
11 AL13-PRD-C1    70      53.84615 11.514620     CAD
12 AL13-PRD-C1    85      65.38462 13.444444     CAD
13 AL13-PRD-C1   100      76.92308 15.748538     CAD
14 AL13-PRD-C1   115      88.46154 16.970760     CAD
15 AL13-PRD-C1   130     100.00000 18.695906     CAD
16 BM06-PRD-S1    25      25.00000 10.094108 Healthy
17 BM06-PRD-S1    40      40.00000 11.734861 Healthy
18 BM06-PRD-S1    55      55.00000 14.120295 Healthy
19 BM06-PRD-S1    70      70.00000 16.133388 Healthy
20 BM06-PRD-S1    85      85.00000 18.494272 Healthy
21 BM06-PRD-S1   100     100.00000 20.654664 Healthy
22 CB19-PRD-S1    25      13.15789 12.621429 Healthy
23 CB19-PRD-S1    40      21.05263 13.510714 Healthy
24 CB19-PRD-S1    55      28.94737 15.446429 Healthy
25 CB19-PRD-S1    70      36.84211 17.771429 Healthy
26 CB19-PRD-S1    85      44.73684 18.639286 Healthy
27 CB19-PRD-S1   100      52.63158 21.050000 Healthy
28 CB19-PRD-S1   115      60.52632 23.985714 Healthy
29 CB19-PRD-S1   130      68.42105 25.582143 Healthy
30 CB19-PRD-S1   145      76.31579 28.000000 Healthy
31 CB19-PRD-S1   160      84.21053 29.150000 Healthy
32 CB19-PRD-S1   175      92.10526 33.489286 Healthy
33 CB19-PRD-S1   190     100.00000 34.907143 Healthy
34 CC14-PRD-S1    20      22.22222  9.634146 Healthy
35 CC14-PRD-S1    30      33.33333 10.747967 Healthy
36 CC14-PRD-S1    40      44.44444 12.089431 Healthy
37 CC14-PRD-S1    50      55.55556 14.288618 Healthy
38 CC14-PRD-S1    60      66.66667 15.341463 Healthy
39 CC14-PRD-S1    70      77.77778 16.207317 Healthy
40 CC14-PRD-S1    80      88.88889 18.117886 Healthy
41 CC14-PRD-S1    90     100.00000 19.556911 Healthy
42 DA03-PRD-C1    20      15.38462  8.047826     CAD
43 DA03-PRD-C1    30      23.07692  8.950000     CAD
44 DA03-PRD-C1    40      30.76923  9.710870     CAD
45 DA03-PRD-C1    50      38.46154 10.410870     CAD
46 DA03-PRD-C1    60      46.15385 10.850000     CAD
47 DA03-PRD-C1    70      53.84615 12.402174     CAD
48 DA03-PRD-C1    80      61.53846 13.410870     CAD
49 DA03-PRD-C1    90      69.23077 13.863043     CAD
50 DA03-PRD-C1   100      76.92308 14.754348     CAD

当前实现代码 #

dput %>% 
  filter(percent_power < 100) %>%
  ggplot(aes(x = percent_power, y = relVO2, color = group)) +
  geom_point(aes(shape = group, size = point_size, color = group)) +
  geom_smooth(method = "lm", formula = y ~ poly(x, 2)) +
  xlab("Percentage of PPO (%)") + 
  ylab(expression(paste("V", O[2]," (mL/min/kg)"))) +
  scale_x_continuous(limits = c(25, 100), breaks = seq(25, 100, by = 25)) +
  theme_classic()

需求说明 #

需要在x轴每5%刻度位置创建点图（点可选择连接或不连接），但部分受试者没有5%增量的观测值，需：

1. 为每个受试者在缺失的5%位置，通过最近的低值和高值进行线性插值
2. 按每5%间隔计算分组均值
3. 生成分组均值点线图的可视化效果

步骤1：数据预处理（插值+分组均值计算） #

使用dplyr、tidyr和线性插值函数approxfun完成数据处理：

library(dplyr)
library(tidyr)
library(ggplot2)

# 过滤掉percent_power=100的行，与原代码逻辑保持一致
processed_data <- dput %>%
  filter(percent_power < 100) %>%
  group_by(id, group) %>%
  # 生成每个受试者需要插值的5%序列：从最小percent_power向上取整到5的倍数，到95%
  mutate(target_x = list(seq(ceiling(min(percent_power)/5)*5, 95, by=5))) %>%
  unnest(target_x) %>%
  # 为每个受试者创建线性插值函数，计算缺失位置的relVO2
  group_by(id) %>%
  mutate(interp_relVO2 = approxfun(percent_power, relVO2)(target_x)) %>%
  ungroup() %>%
  # 按分组和5%刻度计算均值
  group_by(group, target_x) %>%
  summarise(mean_relVO2 = mean(interp_relVO2, na.rm=TRUE),
            .groups = "drop")

步骤2：绘制可视化图形 #

ggplot(processed_data, aes(x = target_x, y = mean_relVO2, color = group)) +
  # 绘制均值点
  geom_point(size=3, aes(shape=group)) +
  # 可选：添加连接线，若不需要可删除此行
  geom_line(linewidth=1) +
  xlab("Percentage of PPO (%)") + 
  ylab(expression(paste("V", O[2]," (mL/min/kg)"))) +
  scale_x_continuous(limits = c(25, 100), breaks = seq(25, 95, by = 5)) +
  theme_classic() +
  # 可选：添加标准误误差棒，展示数据离散程度，不需要可删除此段
  geom_errorbar(data = processed_data %>%
                  group_by(group, target_x) %>%
                  summarise(se = sd(interp_relVO2, na.rm=TRUE)/sqrt(n()),
                            mean_relVO2 = mean(interp_relVO2, na.rm=TRUE),
                            .groups="drop"),
                aes(ymin=mean_relVO2-se, ymax=mean_relVO2+se),
                width=2)

代码说明 #

• 插值逻辑：针对每个受试者生成目标5%刻度序列，用线性插值补全缺失位置的relVO2值，保证每个5%刻度都有对应数据
• 均值聚合：按分组和5%刻度汇总，得到每个位置的平均relVO2
• 绘图选项：可自由选择只展示点，或点线结合；添加误差棒能更直观展示数据的离散情况

内容的提问来源于stack exchange，提问作者MaxB