基于泌乳期条件的月份体重列差值计算需求

核心需求明确 #

• 原数据包含lactation（泌乳期）列，以及wt_jan到wt_dec12个月份的体重列
• 需新增jan_growth到dec_growth列：
  • 2-12月的growth = 当月体重 - 同泌乳期上月体重
  • 1月的growth = 当月体重 - 上一个泌乳期的12月体重（而非自身初始值）

1. 示例数据（可替换为你的真实数据集） #

library(tidyverse)

# 构造和你的数据结构一致的模拟数据
df <- tibble(
  lactation = c(1, 2, 3),
  wt_jan = c(600, 620, 615),
  wt_feb = c(610, 630, 625),
  wt_mar = c(615, 635, 630),
  wt_apr = c(620, 640, 635),
  wt_may = c(625, 642, 640),
  wt_jun = c(630, 645, 642),
  wt_jul = c(632, 647, 645),
  wt_aug = c(635, 648, 648),
  wt_sep = c(638, 650, 650),
  wt_oct = c(642, 652, 652),
  wt_nov = c(645, 653, 653),
  wt_dec = c(650, 645, 655)
)

2. 批量计算2-12月的体重差值 #

不用手动逐个写计算逻辑，用across批量处理更高效：

# 定义月份顺序，用来匹配对应的上月体重列
month_order <- c("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec")

# 批量生成2-12月的growth列
df <- df %>%
  mutate(
    across(
      # 选中2-12月的体重列
      .cols = all_of(paste0("wt_", month_order[-1])),
      .fns = function(current_wt) {
        # 提取当前月份名称
        current_month <- str_remove(cur_column(), "wt_")
        # 找到对应的上月名称
        prev_month <- month_order[which(month_order == current_month) - 1]
        # 计算差值：当前月体重 - 上月体重
        current_wt - !!sym(paste0("wt_", prev_month))
      },
      # 设置新列名规则：比如wt_feb → feb_growth
      .names = "{str_remove(.col, 'wt_')}_growth"
    )
  )

3. 处理1月的跨泌乳期差值 #

1月需要用上一期的12月体重，用lag函数把上一期的wt_dec关联到当前行即可：

df <- df %>%
  # 先按泌乳期排序，确保lag取到的是正确的上一期数据
  arrange(lactation) %>%
  # 新增临时列存储上一期的12月体重
  mutate(prev_period_dec_wt = lag(wt_dec)) %>%
  # 计算1月的growth
  mutate(jan_growth = wt_jan - prev_period_dec_wt) %>%
  # 不需要临时列的话可以直接删除
  select(-prev_period_dec_wt)

4. 最终效果说明 #

处理完成后，数据集会新增12个growth列：

• 2-12月的growth为同泌乳期内当月体重减去上月体重的差值
• 1月的growth为当前泌乳期1月体重减去上一期12月体重，第一期因无前置数据会显示NA（若需要替换为0或其他值，可在jan_growth的计算中加入replace_na(0)）

为什么转置+lag的方案失效？ #

转置后用lag的方法容易因数据分组、缺失值或项目内其他数据处理逻辑冲突导致报错，而上述方法直接在原宽表上操作，无需转换数据结构，兼容性更强，也更容易和项目内其他代码整合。

内容的提问来源于stack exchange，提问作者Cae.rich