R语言实现时间序列周期模式识别与个体时间模式分类

第一步：数据预处理 #

先将你提供的宽表数据转换为长格式，适配arulesSequences的输入要求：

library(tidyverse)
library(arulesSequences)
# 构造原始数据框
df <- structure(list(ID = c("a", "b", "c", "d", "e", "f", "g", "h", 
"i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", 
"v", "w", "x"), `2016/01` = c(1, NA, NA, 1, NA, NA, 1, NA, NA, 
1, NA, 1, 1, 1, NA, 1, NA, NA, 1, NA, NA, 1, NA, NA), `2016/02` = c(NA, 
1, NA, NA, 1, NA, NA, 1, NA, NA, 1, 1, 1, NA, 1, NA, 1, NA, NA, 
1, NA, NA, 1, NA), `2016/03` = c(NA, NA, 1, NA, NA, 1, NA, NA, 
1, 1, NA, 1, 1, 1, NA, NA, NA, 1, NA, NA, 1, NA, NA, 1), `2016/04` = c(NA, 
NA, NA, 1, NA, NA, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, 
1, NA, NA, NA, NA, NA), `2016/05` = c(NA, NA, NA, NA, 1, NA, 
NA, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, 
NA), `2016/06` = c(NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, 1, 
1, 1, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA), `2016/07` = c(NA, 
NA, NA, 1, NA, NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, 1, NA, NA, 
1, NA, NA, NA, NA, NA), `2016/08` = c(NA, NA, NA, NA, 1, NA, 
NA, 1, NA, NA, 1, 1, 1, NA, 1, NA, 1, NA, NA, 1, NA, NA, NA, 
NA), `2016/09` = c(NA, NA, NA, NA, NA, 1, NA, NA, 1, 1, NA, 1, 
1, 1, NA, NA, NA, 1, NA, NA, 1, NA, NA, NA), `2016/10` = c(NA, 
NA, NA, 1, NA, NA, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, 
1, NA, NA, NA, NA, NA), `2016/11` = c(NA, NA, NA, NA, 1, NA, 
NA, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, 
NA), `2016/12` = c(NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, 1, 
1, 1, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA), `2017/01` = c(1, 
NA, NA, 1, NA, NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, 1, NA, NA, 
1, NA, NA, 1, NA, NA), `2017/02` = c(NA, 1, NA, NA, 1, NA, NA, 
1, NA, NA, 1, 1, 1, NA, 1, NA, 1, NA, NA, 1, NA, NA, 1, NA), 
    `2017/03` = c(NA, NA, 1, NA, NA, 1, NA, NA, 1, 1, NA, 1, 
    1, 1, NA, NA, NA, 1, NA, NA, 1, NA, NA, 1), `2017/04` = c(NA, 
    NA, NA, 1, NA, NA, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, 
    NA, 1, NA, NA, NA, NA, NA), `2017/05` = c(NA, NA, NA, NA, 
    1, NA, NA, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA, NA, NA, 1, 
    NA, NA, NA, NA), `2017/06` = c(NA, NA, NA, NA, NA, 1, NA, 
    NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, 
    NA), `2017/07` = c(NA, NA, NA, 1, NA, NA, 1, NA, NA, 1, NA, 
    1, 1, 1, NA, 1, NA, NA, 1, NA, NA, NA, NA, NA), `2017/08` = c(NA, 
    NA, NA, NA, 1, NA, NA, 1, NA, NA, 1, 1, 1, NA, 1, NA, 1, 
    NA, NA, 1, NA, NA, NA, NA), `2017/09` = c(NA, NA, NA, NA, 
    NA, 1, NA, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA, NA, NA, NA, 
    1, NA, NA, NA), `2017/10` = c(NA, NA, NA, 1, NA, NA, NA, 
    NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, 1, NA, NA, NA, NA, 
    NA), `2017/11` = c(NA, NA, NA, NA, 1, NA, NA, NA, NA, 1, 
    NA, 1, 1, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA), `2017/12` = c(1, 
    NA, NA, NA, NA, 1, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, 
    NA, NA, NA, 1, 1, NA, NA), `2018/01` = c(NA, 1, NA, 1, NA, 
    NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, 1, NA, NA, 1, NA, NA, 
    NA, 1, NA), `2018/02` = c(NA, NA, 1, NA, 1, NA, NA, 1, NA, 
    NA, 1, 1, 1, NA, 1, NA, 1, NA, NA, 1, NA, NA, NA, 1), `2018/03` = c(NA, 
    NA, NA, NA, NA, 1, NA, NA, 1, 1, NA, 1, 1, 1, NA, NA, NA, 
    1, NA, NA, 1, NA, NA, NA), `2018/04` = c(NA, NA, NA, 1, NA, 
    NA, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, 1, NA, NA, 
    NA, NA, NA), `2018/05` = c(NA, NA, NA, NA, 1, NA, NA, NA, 
    NA, 1, NA, 1, 1, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA
    ), `2018/06` = c(NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, 1, 
    1, 1, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA), `2018/07` = c(NA, 
    NA, NA, 1, NA, NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, 1, NA, 
    NA, 1, NA, NA, NA, NA, NA), `2018/08` = c(NA, NA, NA, NA, 
    1, NA, NA, 1, NA, NA, 1, 1, 1, NA, 1, NA, 1, NA, NA, 1, NA, 
    NA, NA, NA), `2018/09` = c(NA, NA, NA, NA, NA, 1, NA, NA, 
    1, 1, NA, 1, 1, 1, NA, NA, NA, 1, NA, NA, 1, NA, NA, NA), 
    `2018/10` = c(NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, 1, 1, 
    1, NA, 1, NA, NA, NA, 1, NA, NA, NA, NA, NA), `2018/11` = c(NA, 
    NA, NA, NA, 1, NA, NA, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA, 
    NA, NA, 1, NA, NA, NA, NA), `2018/12` = c(NA, NA, NA, NA, 
    NA, 1, NA, NA, NA, NA, 1, 1, 1, NA, 1, NA, NA, NA, NA, NA, 
    1, NA, NA, NA)), row.names = c(NA, -24L), class = c("tbl_df", 
"tbl", "data.frame"))

# 宽表转长表，过滤无效NA值，保留事件出现的记录
df_long <- df %>% 
  pivot_longer(-ID, names_to = "time", values_to = "event") %>% 
  filter(!is.na(event)) %>% 
  # 将时间转换为数值顺序，方便计算间隔
  mutate(time_id = as.numeric(factor(time, levels = colnames(df)[-1])),
         event = "occur") %>% 
  arrange(ID, time_id)

第二步：构造序列事务对象 #

# 转换为arulesSequences要求的事务格式
seq_data <- as(df_long[, c("ID", "time_id", "event")], "transactions")
transactionInfo(seq_data)$sequenceID <- df_long$ID
transactionInfo(seq_data)$eventID <- df_long$time_id

第三步：挖掘频繁周期序列 #

根据你提到的周期设置间隔约束：双月间隔1-2、季度间隔2-3、半年度间隔5-6、年度间隔11-12，样本量较小的场景下可将支持度阈值设为0.1：

# 用CSPADE算法挖掘频繁序列
freq_seqs <- cspade(seq_data, 
                    parameter = list(support = 0.1, maxgap = 12, mingap = 1),
                    control = list(verbose = FALSE))
# 查看挖掘到的序列结果
as(freq_seqs, "data.frame")

你可以根据序列的固定间隔判断周期类型：

• 间隔固定为12：年度周期，对应a、v这类个体
• 间隔固定为6：半年度周期
• 间隔固定为3：季度周期
• 间隔固定为2：双月周期

第四步：个体模式匹配与分类 #

# 筛选长度≥2的有效周期模式
seq_match <- subset(freq_seqs, size(freq_seqs) >= 2)
match_result <- data.frame(ID = unique(df$ID))
# 逐个匹配每个ID的序列与挖掘到的模式
for(i in 1:length(seq_match)){
  pattern <- seq_match[i]
  matched_IDs <- unique(transactionInfo(seq_data[seq_data %in% pattern])$sequenceID)
  match_result[paste0("pattern_", i)] <- ifelse(match_result$ID %in% matched_IDs, 1, 0)
}
# 匹配完成后可按每个ID匹配到的最高支持度模式完成分类

优化建议 #

• 数据量较大时可调整support阈值和maxgap/mingap范围，定向挖掘目标周期提升效率
• 可先对每个个体的时间序列做自相关分析，先确定可能的周期范围再定向挖掘
• l、m这类全月份都有值的个体可单独归为全量出现类

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