Question

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

 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")))

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

对于我的部分分析，我想选择一个由作业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)

然后可能使用自我/邻域函数，也来自igraph包？但我怎么不确定如何。或者，如果这是最佳方式。

感谢您的时间，

Emil Begtrup-Bright

增加问题：

aichao的答案对于提出的问题是完美的，尽管事实证明需要采取另一个步骤。当创建包含与三个“感兴趣的作业”相关的作业的work.list时，在此示例中为作业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 )

Answer 1

假设您的有向图是从行到列，您可以做的是使用work.list中的每一行将work.list与已连接的列（带元素！= 0）进行扩充。您可以通过以下方式执行此操作：

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中的相关作业{相关或不相关的作业} 1}}。

work.list

这导致：

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索引jobdat.result到irrelevant.job.indices的子矩阵设置非对角线。要做到这一点：

结果是：

## 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

如何在R

增加问题：

1 个答案:

针对扩充问题进行了更新：