如何基于多变量数据集在R中生成周度分城市分职业人口普查表

原代码的核心问题 #

1. 筛选条件错误：filter(cities == i)调用的是你提前提取的城市向量，不是数据集本身的city字段，职业筛选同理，根本筛选不出对应城市/职业的子集
2. 统计逻辑错误：就算筛选条件写对了，后续sapply里又调用了全量的data，没有用到过滤后的子集，计算结果完全不符合要求
3. 索引赋值错误：census[j,x]里的x没有被定义，矩阵的行列数是手动写死的，周数、城市职业数量变动就会出错
4. 性能问题：嵌套循环+逐次过滤的写法在数据量较大时运行效率极低

优化实现（tidyverse 版，易读易维护） #

完全用向量化操作替代循环，自动适配维度变化，不需要手动指定行列数：

library(tidyverse)
library(lubridate)

# 生成周度时间序列
weeks <- seq(from = as.Date("2020-12-27"), to = today(), by = "1 week") %>% 
  as_tibble_col("week_date")

# 生成所有非空的城市+职业组合
city_occp_combo <- data %>% 
  distinct(city, occupation) %>% 
  drop_na()

# 交叉生成所有 周+城市职业 组合，逐行计算在籍人数
census_long <- weeks %>% 
  cross_join(city_occp_combo) %>% 
  rowwise() %>% 
  mutate(population = sum(
    data$city == city & data$occupation == occupation &
    data$move_in <= week_date & 
    (data$move_out > week_date | is.na(data$move_out))
  )) %>% 
  ungroup()

# 转成宽表：行是周，列是城市_职业组合
census_wide <- census_long %>% 
  pivot_wider(
    id_cols = week_date,
    names_from = c(city, occupation),
    values_from = population,
    names_sep = "_"
  )

极致性能版（data.table 版，适合超大数据量） #

如果你的表数据量特别大，用data.table重写可以获得数倍到数十倍的性能提升：

library(data.table)
setDT(data) # 转成data.table格式

# 生成维度组合
weeks <- seq(as.Date("2020-12-27"), today(), by = "1 week")
city_occp_combo <- unique(na.omit(data[, .(city, occupation)]))

# 关联计算人数
census_base <- CJ(week_date = weeks, city = city_occp_combo$city, occupation = city_occp_combo$occupation)
census_long <- census_base[, 
  pop_count := data[.BY, sum(move_in <= week_date & (move_out > week_date | is.na(move_out))), on = .(city, occupation)], 
  by = .(city, occupation, week_date)
]

# 转宽表
census_wide <- dcast(census_long, week_date ~ city + occupation, value.var = "pop_count")

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