如何泛化R语言矩阵运算函数 使其适配任意日期间隔参数设置

核心问题说明 #

• 原代码中的日期修正逻辑if_else(day(new) == 31, new - days(10), new)是为10天间隔硬编码的规则，更换为7天等其他间隔后会直接导致日期分组偏移，int1和int2的分组数量、对应关系完全错乱
• 分组、差值矩阵计算逻辑全部硬编码依赖「每组固定3个元素」的前提，间隔变化后分组长度不匹配时会出现索引越界、取值错误
• 最终结果计算时硬编码取lstMat[1:2]，没有和输入矩阵列表的长度自动对齐

通用化修改后的代码 #

library(lubridate)
library(tidyverse)
library(purrr)

# 可自定义配置项，修改间隔不会影响后续逻辑
DATE_INTERVAL <- "7 day" # 此处可修改为任意你需要的日期间隔
GROUP_SIZE <- 3 # 每组元素个数，需要和你的矩阵维度对应

# 基础数据生成部分和原逻辑一致
date <- rep_len(seq(dmy("26-12-2010"), dmy("20-12-2013"), by = "days"), 500)
ID <- rep(seq(1, 5), 100)
df <- data.frame(date = date,
                 x = runif(length(date), min = 60000, max = 80000),
                 y = runif(length(date), min = 800000, max = 900000),
                 ID)

df$jDate <- julian(as.Date(df$date), origin = as.Date('1970-01-01'))
df$Month <- month(df$date)

t1 <- c(100,150,200)
t2 <- c(200,250,350)
t3 <- c(300,350, 400)
mat <- cbind(t1,t2, t3)

t1 <- c(150,150,200)
t2 <- c(250,250,350)
t3 <- c(350,350, 400)
mat2 <- cbind(t1,t2, t3)
l1 <- list(mat, mat2)

# 日期分组逻辑去掉硬编码修正，只保留通用的floor_date
int1 <- df %>%
  mutate(new = floor_date(date, DATE_INTERVAL)) %>%
  group_by(ID, new) %>%
  filter(Month == 3) %>% 
  group_split()

int2 <- df %>%
  mutate(new = floor_date(date, DATE_INTERVAL)) %>%
  group_by(ID, new) %>%
  filter(Month == 2) %>% 
  group_split()

# 统一int1和int2的长度，取二者的较小值，避免索引越界
max_len <- min(length(int1), length(int2))
int1_trim <- int1[1:max_len]
int2_trim <- int2[1:max_len]

# 动态生成分组标签，自动适配总长度
g1 <- as.integer(gl(max_len, GROUP_SIZE, max_len))

# 重写f1函数，去掉硬编码索引，动态生成差值矩阵
f1 <- function(.int1 ,.int2, group_size = GROUP_SIZE) {
  # 先提取所有int1分组的最小jDate
  int1_mins <- map_dbl(.int1, ~min(.x$jDate))
  # 提取所有int2分组的最小jDate
  int2_mins <- map_dbl(.int2, ~min(.x$jDate))
  # 广播计算所有差值，直接生成矩阵
  out <- matrix(rep(int1_mins, each = group_size) - rep(int2_mins, group_size), nrow = group_size)
  colnames(out) <- paste0("n", 1:group_size)
  return(out)
}

# 生成分组差值矩阵，自动过滤不足group_size的分组
lstMat <- map2(split(int1_trim, g1), split(int2_trim, g1), ~  f1(.x, .y)) %>% 
  compact() # 移除长度不足group_size的空分组

# 自动对齐l1和lstMat的长度，做元素级除法
map2(l1, lstMat[1:length(l1)], `/`)

修改点说明 #

1. 把日期间隔、分组大小都做成了可配置的全局变量，修改时只需要改顶部配置即可，不需要调整后续逻辑
2. 删除了仅适用于10天间隔的硬编码日期修正规则，floor_date本身的分组逻辑是通用的，不需要额外修正
3. 增加了int1和int2的长度对齐逻辑，避免间隔变化后两个分组列表长度不一致导致的索引错误
4. 重写了差值矩阵生成函数，去掉了硬编码的n1/n2/n3写法，通过广播计算自动生成对应维度的差值矩阵，适配任意分组大小
5. 增加了空分组过滤、结果长度自动对齐逻辑，不会因为分组数量变化出现报错

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