R语言加权平均计算for循环替换项数非替换长度倍数问题求解

问题根源 #

• 长度不匹配报错：y_temp是基于lsp单行列的min~max生成的完整序列，而index是dynamics中落在该区间的年份对应行数，二者长度不一致（尤其是lsp的年龄范围超出dynamics时间序列范围时），直接赋值就会触发长度不匹配错误。
• 子集跳过：当lsp某行的年龄范围和dynamics的Year完全无重叠时，index返回空值，不会给dynamics$subset赋值对应序号，后续分组统计时就不会出现该子集，看起来像被跳过。

修改后可运行代码 #

## 加载依赖（原有代码缺该步骤，需提前加载）
library(tidyverse)

## 读入数据集
lsp <- read_csv("lsp_IP.csv")
dynamics <- read_csv("dynamicsLSP.csv")

# 预创建新变量
dynamics$subset <- NA 
dynamics$y <- NA 

# 先获取dynamics的年份上下限，后续仅计算重叠区间
dyn_min <- min(dynamics$Year, na.rm = T)
dyn_max <- max(dynamics$Year, na.rm = T)

for(j in 1:nrow(lsp)) {
  # 计算当前lsp行和dynamics的重叠年份范围
  overlap_min <- max(lsp$min[j], dyn_min)
  overlap_max <- min(lsp$max[j], dyn_max)
  
  # 无重叠直接跳过，不会触发报错
  if(overlap_min > overlap_max) next
  
  # 取dynamics中落在重叠区间的索引
  index <- which(dynamics$Year >= overlap_min & dynamics$Year <= overlap_max)
  # 直接用匹配到的dynamics年份计算权重，保证y_temp长度和index完全一致
  match_years <- dynamics$Year[index]
  y_temp <- dnorm(match_years, mean = lsp$mean[j], sd = lsp$sd[j])
  
  # 赋值不会再有长度不匹配问题
  dynamics$subset[index] <- j 
  dynamics$y[index] <- y_temp
} 

# 计算正确的加权平均：加权和/权重和，加na.rm处理空值
calc <- dynamics %>% 
  group_by(subset) %>% 
  summarise(weighted_average = sum(y * dynamics, na.rm = T)/sum(y, na.rm = T)) 

# 查看结果
view(dynamics)
view(calc)

额外优化说明 #

如果需要保留所有lsp行的结果（包括无重叠的行，对应加权平均返回NA），可以在循环外补充以下代码，就不会出现子集序号缺失的情况：

# 补全所有lsp子集序号
full_calc <- tibble(subset = 1:nrow(lsp)) %>% 
  left_join(calc, by = "subset")

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