如何在R中按ID进行差异化子采样并执行Bootstrap分析

我明白你现在的核心痛点是没法针对每个ID用不同的子采样量批量处理，还要结合Bootstrap完成群体层面的统计。咱们一步步来解决这个问题，先理清逻辑再重构代码：

核心逻辑梳理 #

1. 差异化子采样：对每个ID，先算出它在pre和post阶段的观测数，取两者的最小值作为该ID在两个阶段的统一子采样量，保证跨时间段样本量一致。
2. ID级指标计算：对每个ID的子样本，计算各活动的占比。
3. Bootstrap抽样：重复1000次上述子采样+指标计算过程，得到每个ID的活动占比分布。
4. 群体层面汇总：基于Bootstrap结果，计算所有ID的均值、标准差和置信区间。

完整实现代码 #

先加载需要的包（dplyr用于数据处理，purrr用于批量迭代，tidyr用于数据整理）：

library(dplyr)
library(purrr)
library(tidyr)

1. 准备示例数据 #

set.seed(123) # 设置随机种子保证结果可重复
Data <- data.frame(
  ID = sample(c("A", "B", "C", "D"), 50, replace = TRUE),
  Act = sample(c("eat", "sleep", "play"), 50, replace = TRUE),
  Period = sample(c("pre", "post"), 50, replace = TRUE)
)

2. 计算每个ID的统一子采样量 #

先统计每个ID在两个时间段的观测数，再取最小值：

sample_size_df <- Data %>%
  group_by(ID, Period) %>%
  summarise(n = n(), .groups = "drop") %>%
  pivot_wider(names_from = Period, values_from = n, values_fill = 0) %>%
  rowwise() %>%
  mutate(sample_size = min(pre, post)) %>%
  filter(sample_size > 0) # 过滤掉任一时间段无数据的ID

3. 定义单ID子采样+指标计算函数 #

这个函数会针对单个ID、指定时间段和采样量，返回子样本的活动占比：

get_id_act_prop <- function(id, period, size, data) {
  data %>%
    filter(ID == id, Period == period) %>%
    slice_sample(n = size, replace = FALSE) %>% # 无放回子采样
    count(Act) %>%
    mutate(prop = n / sum(n)) %>%
    select(ID, Act, prop)
}

4. 实现Bootstrap批量处理 #

写一个函数，对所有ID执行指定次数的Bootstrap抽样，返回所有迭代的结果：

bootstrap_analysis <- function(data, sample_size_df, n_reps = 1000) {
  # 初始化存储结果的列表
  bootstrap_results <- vector("list", n_reps)
  
  for (rep in 1:n_reps) {
    # 遍历每个ID，执行子采样并计算占比
    rep_result <- sample_size_df %>%
      pmap_dfr(function(ID, pre, post, sample_size) {
        # 处理pre阶段
        pre_prop <- get_id_act_prop(ID, "pre", sample_size, data) %>%
          mutate(Period = "pre")
        # 处理post阶段
        post_prop <- get_id_act_prop(ID, "post", sample_size, data) %>%
          mutate(Period = "post")
        # 合并两个时间段结果
        bind_rows(pre_prop, post_prop)
      }) %>%
      mutate(replicate = rep)
    
    bootstrap_results[[rep]] <- rep_result
  }
  
  # 把所有迭代结果合并成一个数据框
  bind_rows(bootstrap_results)
}

# 执行1000次Bootstrap
boot_results <- bootstrap_analysis(Data, sample_size_df, n_reps = 1000)

5. 计算ID级和群体层面的统计结果 #

ID级结果（每个ID的活动占比均值、标准差、置信区间）

id_level_stats <- boot_results %>%
  group_by(ID, Period, Act) %>%
  summarise(
    mean_prop = mean(prop),
    sd_prop = sd(prop),
    ci_lower = mean_prop - 1.96 * (sd_prop / sqrt(n())),
    ci_upper = mean_prop + 1.96 * (sd_prop / sqrt(n())),
    .groups = "drop"
  )

print(id_level_stats)

群体层面结果（所有ID的平均活动占比及置信区间）

group_level_stats <- boot_results %>%
  group_by(Period, Act, replicate) %>%
  summarise(group_mean = mean(prop), .groups = "drop") %>%
  group_by(Period, Act) %>%
  summarise(
    overall_mean = mean(group_mean),
    overall_sd = sd(group_mean),
    overall_ci_lower = overall_mean - 1.96 * (overall_sd / sqrt(n())),
    overall_ci_upper = overall_mean + 1.96 * (overall_sd / sqrt(n())),
    .groups = "drop"
  )

print(group_level_stats)

关键改进点说明 #

• 差异化采样：通过sample_size_df为每个ID分配专属的采样量，避免了原代码中固定采样数的问题。
• 批量处理：用pmap_dfr遍历所有ID，同时处理pre和post阶段，实现了批量子采样。
• Bootstrap迭代：通过循环+列表存储，清晰记录每一次迭代的结果，方便后续统计分析。
• 结果可读性：最终输出的统计结果包含了ID级和群体级的均值、标准差及95%置信区间，完全满足你对比pre/post阶段活动占比的需求。

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