如何select基于关系的（邻接）矩阵中的子矩阵，在R
how to select submatrix in a (adjacency) matrix based on ties, in R
我有一个矩阵，表示不同工作之间的流动性：
jobdat <- matrix(c(
295, 20, 0, 0, 0, 5, 7,
45, 3309, 15, 0, 0, 0, 3,
23, 221, 2029, 5, 0, 0, 0,
0, 0, 10, 100, 8, 0, 3,
0, 0, 0, 0, 109, 4, 4,
0, 0, 0, 0, 4, 375, 38,
0, 18, 0, 0, 4, 26, 260),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
这在社交网络分析中被视为定向加权邻接矩阵。
网络的方向是从行到列：因此移动性被定义为从工作行到工作列。对角线是有意义的，因为可以在另一家公司换到同一份工作。
对于我的部分分析，我想要 select 一个由作业 1、作业 5 和作业 7 组成的子矩阵：
work.list <- c(1,5,7)
jobpick_wrong <- jobdat[work.list,work.list]
然而，这只给出了这三个工作之间的直接联系。我需要的是：
jobpick_right <- matrix(c(
295, 20, 0, 5, 7,
45, 3309, 0, 0, 3,
0, 0, 109, 4, 4,
0, 0, 4, 375, 38,
0, 18, 4, 26, 260),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 5","job 6","job 7"),
c("job 1","job 2","job 5","job 6","job 7")))
这里，工作 2 和 6 也包括在内，因为这两个工作也与工作 1、5 或 7 有直接联系。而工作 3 和 4 被排除在外，因为它们与工作 1 没有任何联系, 5 或 7.
我不知道该怎么做。也许我必须将它转换成 igraph 对象才能到达任何地方？
net <- graph.adjacency(jobdat, mode = "directed", weighted = TRUE)
然后也许使用 ego/neighborhood-function，也来自 igraph 包？但是我真的不确定如何。或者这是最好的解决方法。
感谢您的宝贵时间，
Emil Begtrup-Bright
扩充问题：
aichao 的回答非常适合所问的问题，尽管事实证明还需要一个步骤。当创建 work.list 时，其中包含与三个 "jobs of interest" 相关的作业，本例中为作业 1、5、7。然后，对于真实数据，混乱的数量使另一个步骤变得可取：只保留与三个感兴趣的工作之间的 直接 联系，而其他工作之间的联系设置为零.
上面的数据并没有很好地描述这一点，所以我创建了上面的一个非常版本来证明这一点：
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
使用aichaos解决方案：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
然后我们得到这个：
jobdat[work.list,work.list]
# job 1 job 2 job 3 job 5 job 7
# job 1 1 0 1 0 0
# job 2 1 1 1 0 0
# job 3 1 1 1 0 0
# job 5 0 0 0 1 0
# job 7 0 0 0 0 1
但是，工作 2 和工作 3 之间的联系无关紧要，只会掩盖利益联系。
jobdat.result <- matrix(c(
1, 0, 1, 0, 0,
1, 1, 0, 0, 0,
1, 0, 1, 0, 0,
0, 0, 0, 1, 0,
0, 0, 0, 0, 1
),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 5","job 7"),
c("job 1","job 2","job 3","job 5","job 7")))
在 job.dat.result 中，作业 3 和作业 2 之间的联系已被删除，包括行向和列向，但保留了这两个作业和感兴趣的三个作业之间的联系。理想情况下，应该可以选择作业 2 和作业 3 的对角线是否也应为零。但最有可能的是，对于所有作业，我会将对角线设置为零，因此这不是必需的。但这很好，如果没有别的，那么我可以在更高层次上理解它的逻辑。
除其他外，我想要实现的是像这样的圆图：
所以领带数量的简单性很重要。图表转载如下：
library(circlize)
segmentcircle <- jobdat
diag(segmentcircle) <- 0
df.c <- get.data.frame(graph.adjacency(segmentcircle,weighted=TRUE))
colour <- brewer.pal(ncol(segmentcircle),"Set1")
chordDiagram(x = df.c,
grid.col = colour,
transparency = 0.2,
directional = 1, symmetric=FALSE,
direction.type = c("arrows", "diffHeight"), diffHeight = -0.065,
link.arr.type = "big.arrow",
# self.link=1
link.sort = TRUE, link.largest.ontop = TRUE,
link.border="black",
# link.lwd = 2,
# link.lty = 2
)
假设你的有向图是从行到列，你可以做的是增加你的 work.list 与那些连接（元素！=0）到 [=20= 中的每一行的列].您可以通过以下方式做到这一点：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
使用 unique 仅保留唯一的列组合，并使用 sort 以便这些列按其索引排序。那么：
jobdat[work.list,work.list]
## job 1 job 2 job 5 job 6 job 7
##job 1 295 20 0 5 7
##job 2 45 3309 0 0 3
##job 5 0 0 109 4 4
##job 6 0 0 4 375 38
##job 7 0 18 4 26 260
相反，如果您的有向图是从列到行：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
已更新扩充问题：
随着新 jobdat:
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
和work.list中的相关职位列表：
work.list <- c(1,5,7)
计算扩充工作列表 aug.work.list 作为直接转到 work.list 中相关工作的工作集合。这将包括工作 2 和 3。请注意，我们在这里使用 which(jobdat[,x] != 0) 而不是 which(jobdat[x,] != 0) 来标识连接到 [= 中的相关工作 x 的工作（相关或不相关） 20=].
aug.work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
##[1] 1 2 3 5 7
这导致：
jobdat.result <- jobdat[aug.work.list, aug.work.list]
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 1 0 0
##job 3 1 1 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1
现在，要去除不相关作业之间的联系，首先在 jobdat.result 中找到这些不相关作业的索引，这些索引是 aug.work.list 中不在 work.list 中的元素的索引
irrelevant.job.indices <- which(!(aug.work.list %in% work.list))
##[1] 2 3
请注意，这些不是不相关职位的职位编号，而是 jobdat.result 中对应于不相关职位编号的（行和列）索引。
在这种情况下，它们恰好对应于工作编号本身。
删除连接需要将 irrelevant.job.indices 索引的 jobdat.result 的子矩阵的非对角线设置为 0。为此：
## first, keep diagonal values for irrelevant.job.indices
dvals <- diag(jobdat.result)[irrelevant.job.indices]
## set sub-matrix to zero (this will also set diagnal elements to zero)
jobdat.result[irrelevant.job.indices,irrelevant.job.indices] <- 0
## replace diagonal elements
diag(jobdat.result)[irrelevant.job.indices] <- dvals
结果是：
jobdat.result
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 0 0 0
##job 3 1 0 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1
我有一个矩阵，表示不同工作之间的流动性：
jobdat <- matrix(c(
295, 20, 0, 0, 0, 5, 7,
45, 3309, 15, 0, 0, 0, 3,
23, 221, 2029, 5, 0, 0, 0,
0, 0, 10, 100, 8, 0, 3,
0, 0, 0, 0, 109, 4, 4,
0, 0, 0, 0, 4, 375, 38,
0, 18, 0, 0, 4, 26, 260),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
这在社交网络分析中被视为定向加权邻接矩阵。 网络的方向是从行到列：因此移动性被定义为从工作行到工作列。对角线是有意义的，因为可以在另一家公司换到同一份工作。
对于我的部分分析，我想要 select 一个由作业 1、作业 5 和作业 7 组成的子矩阵：
work.list <- c(1,5,7)
jobpick_wrong <- jobdat[work.list,work.list]
然而，这只给出了这三个工作之间的直接联系。我需要的是：
jobpick_right <- matrix(c(
295, 20, 0, 5, 7,
45, 3309, 0, 0, 3,
0, 0, 109, 4, 4,
0, 0, 4, 375, 38,
0, 18, 4, 26, 260),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 5","job 6","job 7"),
c("job 1","job 2","job 5","job 6","job 7")))
这里，工作 2 和 6 也包括在内，因为这两个工作也与工作 1、5 或 7 有直接联系。而工作 3 和 4 被排除在外，因为它们与工作 1 没有任何联系, 5 或 7.
我不知道该怎么做。也许我必须将它转换成 igraph 对象才能到达任何地方？
net <- graph.adjacency(jobdat, mode = "directed", weighted = TRUE)
然后也许使用 ego/neighborhood-function，也来自 igraph 包？但是我真的不确定如何。或者这是最好的解决方法。
感谢您的宝贵时间，
Emil Begtrup-Bright
扩充问题：
aichao 的回答非常适合所问的问题，尽管事实证明还需要一个步骤。当创建 work.list 时，其中包含与三个 "jobs of interest" 相关的作业，本例中为作业 1、5、7。然后，对于真实数据，混乱的数量使另一个步骤变得可取：只保留与三个感兴趣的工作之间的 直接 联系，而其他工作之间的联系设置为零.
上面的数据并没有很好地描述这一点，所以我创建了上面的一个非常版本来证明这一点：
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
使用aichaos解决方案：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
然后我们得到这个：
jobdat[work.list,work.list]
# job 1 job 2 job 3 job 5 job 7
# job 1 1 0 1 0 0
# job 2 1 1 1 0 0
# job 3 1 1 1 0 0
# job 5 0 0 0 1 0
# job 7 0 0 0 0 1
但是，工作 2 和工作 3 之间的联系无关紧要，只会掩盖利益联系。
jobdat.result <- matrix(c(
1, 0, 1, 0, 0,
1, 1, 0, 0, 0,
1, 0, 1, 0, 0,
0, 0, 0, 1, 0,
0, 0, 0, 0, 1
),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 5","job 7"),
c("job 1","job 2","job 3","job 5","job 7")))
在 job.dat.result 中，作业 3 和作业 2 之间的联系已被删除，包括行向和列向，但保留了这两个作业和感兴趣的三个作业之间的联系。理想情况下，应该可以选择作业 2 和作业 3 的对角线是否也应为零。但最有可能的是，对于所有作业，我会将对角线设置为零，因此这不是必需的。但这很好，如果没有别的，那么我可以在更高层次上理解它的逻辑。
除其他外，我想要实现的是像这样的圆图：
所以领带数量的简单性很重要。图表转载如下：
library(circlize)
segmentcircle <- jobdat
diag(segmentcircle) <- 0
df.c <- get.data.frame(graph.adjacency(segmentcircle,weighted=TRUE))
colour <- brewer.pal(ncol(segmentcircle),"Set1")
chordDiagram(x = df.c,
grid.col = colour,
transparency = 0.2,
directional = 1, symmetric=FALSE,
direction.type = c("arrows", "diffHeight"), diffHeight = -0.065,
link.arr.type = "big.arrow",
# self.link=1
link.sort = TRUE, link.largest.ontop = TRUE,
link.border="black",
# link.lwd = 2,
# link.lty = 2
)
假设你的有向图是从行到列，你可以做的是增加你的 work.list 与那些连接（元素！=0）到 [=20= 中的每一行的列].您可以通过以下方式做到这一点：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
使用 unique 仅保留唯一的列组合，并使用 sort 以便这些列按其索引排序。那么：
jobdat[work.list,work.list]
## job 1 job 2 job 5 job 6 job 7
##job 1 295 20 0 5 7
##job 2 45 3309 0 0 3
##job 5 0 0 109 4 4
##job 6 0 0 4 375 38
##job 7 0 18 4 26 260
相反，如果您的有向图是从列到行：
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
已更新扩充问题：
随着新 jobdat:
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
和work.list中的相关职位列表：
work.list <- c(1,5,7)
计算扩充工作列表 aug.work.list 作为直接转到 work.list 中相关工作的工作集合。这将包括工作 2 和 3。请注意，我们在这里使用 which(jobdat[,x] != 0) 而不是 which(jobdat[x,] != 0) 来标识连接到 [= 中的相关工作 x 的工作（相关或不相关） 20=].
aug.work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
##[1] 1 2 3 5 7
这导致：
jobdat.result <- jobdat[aug.work.list, aug.work.list]
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 1 0 0
##job 3 1 1 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1
现在，要去除不相关作业之间的联系，首先在 jobdat.result 中找到这些不相关作业的索引，这些索引是 aug.work.list 中不在 work.list 中的元素的索引
irrelevant.job.indices <- which(!(aug.work.list %in% work.list))
##[1] 2 3
请注意，这些不是不相关职位的职位编号，而是 jobdat.result 中对应于不相关职位编号的（行和列）索引。
在这种情况下，它们恰好对应于工作编号本身。
删除连接需要将 irrelevant.job.indices 索引的 jobdat.result 的子矩阵的非对角线设置为 0。为此：
## first, keep diagonal values for irrelevant.job.indices
dvals <- diag(jobdat.result)[irrelevant.job.indices]
## set sub-matrix to zero (this will also set diagnal elements to zero)
jobdat.result[irrelevant.job.indices,irrelevant.job.indices] <- 0
## replace diagonal elements
diag(jobdat.result)[irrelevant.job.indices] <- dvals
结果是：
jobdat.result
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 0 0 0
##job 3 1 0 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1