R语言：单循环转双循环的抽样偏差计算代码修正

问题分析 #

• 原代码外层循环保存结果时，id_i = i仅取到内层循环的最后一个迭代值，并未正确记录每个内层循环的索引关联关系
• 若需完整保留双循环的所有迭代数据，需调整数据存储结构；若仅需每个外层循环对应的内层偏差平均值，可简化索引记录逻辑

修正代码（两种方案） #

方案1：保留所有双循环迭代的详细结果 #

该方案保存每个外层循环j、内层循环i对应的偏差值，方便后续全量分析：

library(dplyr)
library(purrr)
set.seed(123) # 设置随机种子保证结果可复现

# 数据集构建（复用原代码）
my_data1 = data.frame(var1 =  rnorm(500,100,100), prop = runif(500, min=0, max=0.5))
my_data2 = data.frame(var1 = rnorm(500, 200, 50), prop = runif(500, min=0.4, max=0.7))
my_data = rbind(my_data1, my_data2)

# 定义迭代次数（可快速修改为100）
total_j <- 10
total_i <- 10

my_list = list()

for (j in 1:total_j) {
    base_j = sample_n(my_data, 700)
    base_comp_j = base_j %>%
        arrange(var1) %>%
        mutate(ntile = ntile(var1, 10)) %>%
        group_by(ntile) %>%
        summarise(mean = mean(prop))
    sampling_frame_j = my_data %>% anti_join(base_j)
    
    for (i in 1:total_i) {
        a_i = sample_n(sampling_frame_j, 100)
        base_a_i = a_i %>%
            arrange(var1) %>%
            mutate(ntile = ntile(var1, 10)) %>%
            group_by(ntile) %>%
            summarise(mean = mean(prop))
        sum_i <- sum(map2_dbl(base_a_i$mean, base_comp_j$mean, function(x, y) (x - y)^2))
        
        # 记录当前双层索引及偏差值
        my_list[[length(my_list)+1]] <- data.frame(id_j = j, id_i = i, sum_i = sum_i)
    }
}

# 合并结果并计算每个外层循环的平均偏差
results = do.call(rbind.data.frame, my_list)
results_summary <- results %>%
    group_by(id_j) %>%
    summarise(average_sum_i_j = mean(sum_i))

# 可视化
plot(density(results_summary$average_sum_i_j), main = "平均偏差的分布")
plot(results_summary$id_j, results_summary$average_sum_i_j, xlab = "外层迭代次数", ylab = "平均偏差", main = "平均偏差轨迹图", type = "b")

方案2：仅保留每个外层循环的内层平均偏差（简化版） #

如果只需要每个外层循环对应的内层偏差平均值，无需保存内层迭代的详细数据，可使用该方案：

library(dplyr)
library(purrr)
set.seed(123)

# 数据集构建（复用原代码）
my_data1 = data.frame(var1 =  rnorm(500,100,100), prop = runif(500, min=0, max=0.5))
my_data2 = data.frame(var1 = rnorm(500, 200, 50), prop = runif(500, min=0.4, max=0.7))
my_data = rbind(my_data1, my_data2)

# 定义迭代次数（可快速修改为100）
total_j <- 10
total_i <- 10

my_list = list()

for (j in 1:total_j) {
    base_j = sample_n(my_data, 700)
    base_comp_j = base_j %>%
        arrange(var1) %>%
        mutate(ntile = ntile(var1, 10)) %>%
        group_by(ntile) %>%
        summarise(mean = mean(prop))
    sampling_frame_j = my_data %>% anti_join(base_j)
    
    # 用向量存储内层偏差，比列表更高效
    sum_i_vec <- numeric(total_i)
    for (i in 1:total_i) {
        a_i = sample_n(sampling_frame_j, 100)
        base_a_i = a_i %>%
            arrange(var1) %>%
            mutate(ntile = ntile(var1, 10)) %>%
            group_by(ntile) %>%
            summarise(mean = mean(prop))
        sum_i_vec[i] <- sum(map2_dbl(base_a_i$mean, base_comp_j$mean, function(x, y) (x - y)^2))
    }
    
    average_sum_i_j = mean(sum_i_vec)
    my_list[[j]] <- data.frame(id_j = j, average_sum_i_j = average_sum_i_j)
    print(my_list[[j]])
}

results = do.call(rbind.data.frame, my_list)

# 可视化
plot(density(results$average_sum_i_j), main = "平均偏差的分布")
plot(results$id_j, results$average_sum_i_j, xlab = "外层迭代次数", ylab = "平均偏差", main = "平均偏差轨迹图", type = "b")

关键修正点 #

• 方案1中，每次内层循环都向列表添加包含id_j和id_i的记录，确保双索引正确关联
• 方案2中，用向量存储内层偏差值，避免冗余的列表操作，同时去掉无意义的id_i字段
• 统一设置迭代次数变量，方便快速修改为需求的100次
• 保留随机种子保证结果可复现

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