R语言dplyr使用row_number()分组计数时处理数据集缺失值NA

原始数据 #

构造测试用车辆持有数据框的代码如下：

car <- data.frame(stringsAsFactors = FALSE, 
                  year = c(2010,2011,2012,2013,2014,2015,2010,2011,2012,2013,2014,2015,2011,2012,2013,2014,2015), 
                  person = c("A","A","A","A","A","A", "B","B","B","B","B","B","C","C","C","C","C"),
                  car = c("BMW", "BMW", "AUDI", "AUDI", "AUDI", "Mercedes", "Citroen","Citroen", "Citroen", "Toyota", "Toyota", "Peugeot", "Volkswagen","Volkswagen","Mercedes", "Mercedes","Tesla"))

需求说明 #

需要生成how_long_does_the_person_have_the_car（用户持有车辆时长）字段，计算规则：

• 按用户维度以年份升序排列，同一位用户连续持有同一辆车的记录记为一个持有周期
• 每个持有周期内按年份从1开始累计计数，用户换车、用户变更时计数重置
• 特殊规则：如果某用户的首次观测年份晚于数据集全局最早年份，说明缺失该用户前期持有数据，该用户的第一个持有周期所有记录的时长值标记为NA（也可按需求替换为0），后续换车后的持有周期正常从1开始计数。

预期输出结果如下：

tibble::tribble(
~year, ~person, ~car, ~how_long_does_the_person_have_the_car,
2010, "A", "BMW", 1,
2011, "A", "BMW", 2,
2012, "A", "AUDI", 1,
2013, "A", "AUDI", 2,
2014, "A", "AUDI", 3,
2015, "A", "Mercedes", 1,
2010, "B", "Citroen", 1,
2011, "B", "Citroen", 2,
2012, "B", "Citroen", 3,
2013, "B", "Toyota", 1,
2014, "B", "Toyota", 2,
2015, "B", "Peugeot", 1,
2011, "C", "Volkswagen", NA,
2012, "C", "Volkswagen", NA,
2013, "C", "Mercedes", 1,
2014, "C", "Mercedes", 2,
2015, "C", "Tesla", 1
)

初始实现问题 #

最初使用的dplyr代码仅按person和car分组生成行号，既没有识别连续持有周期，也没有处理首年观测缺失的场景：

car <- car %>% 
   group_by(person, car) %>% 
   mutate( how_long_does_the_person_have_the_car = row_number())

运行后用户C的前两条大众记录被错误计数为1、2，不符合需求。

修正代码 #

实现逻辑：

1. 先按用户、年份排序，保证记录顺序正确
2. 给每个用户的连续同车持有段打标记，区分同一用户换车后又换回同款车的不同周期
3. 计算全局最早观测年份，标记每个用户的首次观测年份
4. 对每个持有段做组内累计计数，仅当记录属于用户第一个持有段、且用户首次观测年份晚于全局最早年份时，将计数值替换为NA

完整可运行代码：

library(dplyr)

global_min_year <- min(car$year)

car_result <- car %>%
  arrange(person, year) %>%
  group_by(person) %>%
  # 标记连续持有同车的段ID
  mutate(hold_seg = cumsum(car != lag(car, default = first(car))) + 1) %>%
  group_by(person, hold_seg) %>%
  # 段内累计计数
  mutate(seg_count = row_number()) %>%
  group_by(person) %>%
  mutate(
    person_first_year = min(year),
    how_long_does_the_person_have_the_car = ifelse(
      hold_seg == 1 & person_first_year > global_min_year,
      NA,
      seg_count
    )
  ) %>%
  # 移除辅助列
  select(-hold_seg, -seg_count, -person_first_year) %>%
  ungroup()

运行结果和预期完全一致，如果需要将缺失值标记为0，把代码里的NA替换为0即可。

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