在行和列上同时折叠/聚合邻接矩阵的某些部分

Question

我有一个矩阵，代表不同工作之间的流动性：

jobnames <-  c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")
jobdat <- matrix(c(
5, 5, 5, 0, 0, 5, 5,
5, 5, 2, 5, 5, 1, 5,
1, 5, 5, 5, 0, 0, 1,
1, 0, 5, 5, 8, 0, 1,
0, 5, 0, 0, 5, 5, 1,
0, 0, 5, 5, 0, 5, 5,
0, 1, 0, 0, 5, 1, 5
           ), 
           nrow = 7, ncol = 7, byrow = TRUE,
           dimnames = list(jobnames,jobnames
                ))

这在社交网络分析中被视为有向加权邻接矩阵。网络的方向是从行到列：因此移动性被定义为从工作行到工作列。对角线是相关的，因为有可能换到另一家公司的同一份工作。

我需要根据预先设定的列表折叠这个矩阵 包含应合并的作业的索引：

group.list  <-  list(grp1=c(1,2) ,grp2 =c(3,4))

现在，由于它是一个邻接矩阵，它与我在这里和其他地方找到的关于如何折叠矩阵的其他答案有点不同。折叠必须在行和列上同时进行。有些工作根本没有分组。所以这个例子中的结果应该是这样的：

group.jobnames <-  c("job 1 and 2","job 3 and 4","job 5","job 6","job 7")

 group.jobdat <- matrix(c(
            20,12,5,6,10,
            7,17,8,0,2,
            5,0,5,5,1,
            0,10,0,5,5,
            1,0,5,1,5
            ),
           nrow = 5, ncol = 5, byrow = TRUE,
           dimnames = list(group.jobnames,group.jobnames
                ))

此示例将前两个作业分组，然后将接下来的两个作业分组，但在我的实际数据中，它可以是作业（索引）的任意组合，以及每组中任意数量的作业。所以工作 [1,7] 可以是一个组，工作 [2,3,6] 可以是另一个组，而工作 4 或 5 没有分组。或任何其他组合。

感谢您的宝贵时间，

Answer 1

我相信预期输出和 group.list 定义中有一些拼写错误。如果我的解释是正确的，这里有一个解决方案。

这是一个新的 group.list 以符合所需输出的名称。在这个版本中，组 2 映射到 1，组 4 映射到 3，这与 group.jobs 中的文本一致。

group.list <- list(grp1=c(1, 3), grp2=c(2, 4))

给定这个列表，构造一个分组向量

# initial grouping
groups <- seq_len(ncol(jobdat))
# map elements of second list item to values of first list item
groups[match(group.list[["grp2"]], groups)] <- group.list[["grp1"]]

groups
[1] 1 1 3 3 5 6 7

因此，现在第 1 组和第 2 组以及第 3 组和第 4 组相同。现在，我们使用 rowsum 和几个转置来计算输出。

myMat <- t(rowsum(t(rowsum(jobdat, groups)), groups))
# add the group names
dimnames(myMat) <- list(group.jobnames,group.jobnames)

myMat
            job 1 and 2 job 3 and 4 job 5 job 6 job 7
job 1 and 2          20          12     5     6    10
job 3 and 4           7          20     8     0     2
job 5                 5           0     5     5     1
job 6                 0          10     0     5     5
job 7                 1           0     5     1     5

---

响应下面的 OP 的 cmets，分组旨在位于列表元素内，而不是我最初解释的列表元素之间的对应位置。为了完成这种分组，重复输入replace 到Reduce 将完成任务。 与问题中的 group.list 一样，

group.list <- list(grp1=c(1, 2), grp2=c(3, 4))

groups <- Reduce(function(x, y) replace(x, x[x %in% y], min(y)),
                 c(list(groups), unname(group.list)))
groups
[1] 1 1 3 3 5 6 7

这里，replace 采用原始分组，在 group.list 中的一个向量中查找分组中的元素，并将这些元素替换为该向量的最小值。 Reduce 函数重复地对原始组变量应用此操作，除了在每次迭代中修改它。

有了这个结果，我们用上面的转置和rowsum得到

myMat
            job 1 and 2 job 3 and 4 job 5 job 6 job 7
job 1 and 2          20          12     5     6    10
job 3 and 4           7          20     8     0     2
job 5                 5           0     5     5     1
job 6                 0          10     0     5     5
job 7                 1           0     5     1     5