在R中基于数据框构建企业间邻接矩阵的技术求助

首先预处理数据，将原数据中字符型的"NA"转换为真实缺失值，避免后续处理出错：

dd <- data.frame(company=c(1,1,2,2,3,3,4,4),
                  date=c("2020_01","2020_02","2020_01","2020_02","2020_01","2020_02","2020_01","2020_02"),
                  employee1 = c("A","A","B","B","C","C","D","U"),
                  employee2 = c("E","NA","F","F","A","A","Z","Z"),
                  employee3 = c("NA","NA","NA","NA","B","B","Y","E"))
# 转换字符型NA为真实缺失值
dd[dd == "NA"] <- NA

1. 企业间共享员工的邻接矩阵 #

核心思路是找出在多家企业任职的员工，统计每对企业共享的员工数量：

library(dplyr)
library(tidyr)

# 整理员工-企业对应关系，生成共享员工的企业对
shared_pairs <- dd %>%
  pivot_longer(cols = starts_with("employee"), values_to = "employee") %>%
  filter(!is.na(employee)) %>%
  group_by(employee) %>%
  filter(n_distinct(company) >= 2) %>%
  summarise(pairs = list(t(combn(sort(unique(company)), 2)))) %>%
  unnest(pairs) %>%
  separate(pairs, into = c("from", "to"), sep = " ", convert = TRUE) %>%
  count(from, to, name = "shared_count")

# 生成邻接矩阵
companies <- sort(unique(dd$company))
shared_adj_matrix <- matrix(0, nrow = length(companies), ncol = length(companies),
                            dimnames = list(companies, companies))

# 填充矩阵对称位置的值
for (row in 1:nrow(shared_pairs)) {
  shared_adj_matrix[as.character(shared_pairs$from[row]), as.character(shared_pairs$to[row])] <- shared_pairs$shared_count[row]
  shared_adj_matrix[as.character(shared_pairs$to[row]), as.character(shared_pairs$from[row])] <- shared_pairs$shared_count[row]
}

# 查看结果
print(shared_adj_matrix)

运行后得到的矩阵中，仅企业1与3的位置值为1，对应共享员工"A"，其余均为0。

2. 企业间员工流动的邻接矩阵 #

核心思路是追踪员工在不同时间的企业归属变化，统计每对企业间的员工流动次数：

# 整理员工流动的企业对
movement_pairs <- dd %>%
  pivot_longer(cols = starts_with("employee"), values_to = "employee") %>%
  filter(!is.na(employee)) %>%
  mutate(date = factor(date, levels = c("2020_01", "2020_02"), ordered = TRUE)) %>%
  arrange(employee, date) %>%
  group_by(employee) %>%
  mutate(prev_company = lag(company)) %>%
  filter(!is.na(prev_company) & prev_company != company) %>%
  count(prev_company, company, name = "move_count") %>%
  rename(from = prev_company, to = company)

# 生成邻接矩阵
movement_adj_matrix <- matrix(0, nrow = length(companies), ncol = length(companies),
                              dimnames = list(companies, companies))

# 填充矩阵流动方向的值
for (row in 1:nrow(movement_pairs)) {
  movement_adj_matrix[as.character(movement_pairs$from[row]), as.character(movement_pairs$to[row])] <- movement_pairs$move_count[row]
}

# 查看结果
print(movement_adj_matrix)

运行后得到的矩阵中，仅企业1到4的位置值为1，对应员工"E"从企业1流动到企业4，其余均为0。

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