在R中生成基于日期的双向矩阵型出现次数数据框列表
问题描述
原始数据框定义如下:
A <- data.frame(Actor1 = c("A1", "B2", "C3", "D4"), Actor2 = c("A1", "C4", "F2", "B2"), Dates = as.Date(c('1999/01/01', "1999/02/05", "1999/05/06", "2000/03/06")), Case = c(4, 6, 8, 10)) Actor <- unique(c(A$Actor1, A$Actor2))
需求是将上述基于参与者事件的数据框转换为按日期分组的数据框列表:
- 每个数据框对应单独一天,覆盖指定时间范围内的所有日期
- 每个数据框的行名和列名为所有参与者名称
- 若两名参与者在当天有交互(即原始数据中存在该日期的
Actor1与Actor2记录),则对应位置设为1,其余位置默认留空(或设为NA/0,可按需调整)
期望效果示例(简化版):
# 1999年1月1日的数据框 Jan_01_99 <- data.frame(matrix(ncol = 6, nrow = 6)) colnames(Jan_01_99) <- Actor rownames(Jan_01_99) <- Actor Jan_01_99[1,1] <- 1 # A1与A1的交互 # 1999年1月2日的数据框(无交互,全为空) Jan_02_99 <- data.frame(matrix(ncol = 6, nrow = 6)) colnames(Jan_02_99) <- Actor rownames(Jan_02_99) <- Actor # 1999年2月5日的数据框 Feb_05_99 <- data.frame(matrix(ncol = 6, nrow = 6)) colnames(Feb_05_99) <- Actor rownames(Feb_05_99) <- Actor Feb_05_99[2,5] <- 1 # B2与C4的交互 # 最终列表 complete_List <- list(Jan_01_99, Jan_02_99, Feb_05_99)
解决方案
以下提供两种实现方式,均能满足需求:
方式一:基础R原生实现
# 1. 确定完整时间范围:从最早到最晚日期的所有天数 date_range <- seq(min(A$Dates), max(A$Dates), by = "day") # 2. 提取所有参与者 actors <- unique(c(A$Actor1, A$Actor2)) n_actors <- length(actors) # 3. 初始化空列表,用日期格式命名元素 complete_list <- vector("list", length(date_range)) names(complete_list) <- format(date_range, "%b_%d_%y") # 4. 遍历每个日期生成对应邻接数据框 for(i in seq_along(date_range)) { current_date <- date_range[i] # 创建空矩阵,行列名为参与者 adj_matrix <- matrix(NA, nrow = n_actors, ncol = n_actors, dimnames = list(actors, actors)) # 筛选当天的交互记录并填充1 daily_events <- subset(A, Dates == current_date) if(nrow(daily_events) > 0) { for(j in 1:nrow(daily_events)) { adj_matrix[daily_events$Actor1[j], daily_events$Actor2[j]] <- 1 } } # 转换为数据框存入列表 complete_list[[i]] <- as.data.frame(adj_matrix) } # 查看示例结果 complete_list[["Jan_01_99"]]
方式二:使用tidyverse简化操作
如果习惯使用tidyverse工具链,代码会更简洁:
library(dplyr) library(tidyr) # 1. 生成所有日期-参与者对的完整网格 full_grid <- expand_grid( Dates = seq(min(A$Dates), max(A$Dates), by = "day"), Actor1 = actors, Actor2 = actors ) # 2. 标记有交互的位置为1,其余为NA daily_adj <- full_grid %>% left_join(A %>% select(Dates, Actor1, Actor2), by = c("Dates", "Actor1", "Actor2")) %>% mutate(value = ifelse(!is.na(Case), 1, NA)) %>% select(-Case) # 3. 按日期拆分并转换为数据框列表 complete_list <- daily_adj %>% pivot_wider(names_from = Actor2, values_from = value) %>% group_split(Dates, .keep = FALSE) %>% set_names(format(date_range, "%b_%d_%y")) # 查看示例结果 complete_list[["Feb_05_99"]]
补充说明
- 两种方式都会生成覆盖从最早到最晚日期所有天数的列表
- 列表元素名称采用
%b_%d_%y格式(如Jan_01_99),与示例一致 - 无交互位置默认设为NA,若需要设为0,只需将代码中的
NA替换为0即可
内容的提问来源于stack exchange,提问作者Sulz
相关产品推荐
相关产品推荐

