根据图中的两个随机遍历构建矩阵

Question

我正在研究一个项目而且我达到了这一点，但实际上我在一周前就被困在了它上面，我尝试了很多想法，但是所有试验来编码我的算法都失败了。

假设我们有以下简单的图表：

依次为：1--3，1--4，3--2

对于每个边缘，在每个顶点上定义随机游走以移动到其中一个邻居，如：

对于第一个边缘，v1=1 ,v2=3, n1=3,4和n2=1,2按顺序排列，因此v1和v2的可能移动是：

1 to 3,3 to 1
1 to 4,3 to 1
1 to 3,3 to 2
1 to 4,3 to 2

对于第二个边缘，v1=1 ,v2=4, n1=3,4和n2=1按顺序排列，因此v1和v2的可能移动是：

1 to 3,4 to 1
1 to 4,3 to 1

对于第三个边缘，v1=3 ,v2=2, n1=1,2和n2=3按顺序排列，因此v1和v2的可能移动是：

3 to 1,2 to 3
3 to 2,2 to 3

对于整个图表，只有 8个可能的移动所以我有 8个变量来构建约束矩阵

让我们用x表示移动（根据它们的出现顺序）;即

(1 to 3,3 to 1) to be represented by x_1
(1 to 4,3 to 1) to be represented by x_2
                 :
(3 to 1,2 to 3) to be represented by x_7
(3 to 2,2 to 3) to be represented by x_8

我想根据这些移动构建所需的约束矩阵，约束的数量将等于\sum{i} ( number of neighbors for v1(i) * number of neighbors for v2(i) )，在我们的图中为10。

构建此矩阵的算法是：

Step1: 1) select 1st edge, fix v1, v2, n2
       2) change n1 and fill the 1st row of the matrix by 1's in the place of the resulted moves and 0 if there is no similar move on the graph until you finish all elements in n1. 
Step2: move to the 2nd row of the matrix and select the 2nd element of n2 and
       1) loop over n1 
       2) fill the 2nd row by 1's in the place of the resulted moves until you finish all elements in n1. 
Step3: since you selected all elements in n1 and n2 for the vertices in the first edge move to a new row in the matrix 
Step4: Select next edges and do the same work done before until you finish all edges. 
Step5: select the 1st edge again and do the same work but while fixing v1,v2 &n1, loop over n2

根据该算法得到的矩阵将是：

1 1 0 0 0 0 0 0
0 0 1 1 0 0 0 0
0 0 0 0 1 1 0 0
0 0 0 0 0 0 1 1
1 0 1 0 0 0 0 0
0 1 0 1 0 0 0 0
0 0 0 0 1 0 0 0
0 0 0 0 0 1 0 0
0 0 0 0 0 0 1 0
0 0 0 0 0 0 0 1

我没做的是：如何让矩阵知道有一个移动，并将其替换为1的位置，如果没有移动来替换它在它的位置上加0

我的代码是：

library(igraph)
graph<-matrix(c(1,3,1,4,3,2),ncol=2,byrow=TRUE)
g<-graph.data.frame(d = graph, directed = FALSE)

countercol<-0
for (edge in 1:length(E(g))){
v1<-ends(graph = g, es = edge)[1]
v2<-ends(graph = g, es = edge)[2]

n1<-neighbors(g,v1,mode=c("all"))
n2<-neighbors(g,v2,mode=c("all"))

countercol=countercol+(length(n1)*length(n2))
}

counterrow<-0
for (edge in 1:length(E(g))){
v1<-ends(graph = g, es = edge)[1]
v2<-ends(graph = g, es = edge)[2]

n1<-neighbors(g,v1,mode=c("all"))
n2<-neighbors(g,v2,mode=c("all"))

counterrow=counterrow+(length(n1)+length(n2))
}    

for (edge in 1:length(E(df))){
v1<-ends(graph = df, es = edge)[1]
v2<-ends(graph = df, es = edge)[2]
n1<-neighbors(df,v1,mode=c("all"))
n2<-neighbors(df,v2,mode=c("all"))
  ...
  ...
  ...
  }

我不是在找人写代码，我想要的是让程序区分可能的移动，并将存储1和0放在合适的位置以便进行移动

非常感谢任何帮助

Answer 1

这是一个由两部分组成的解决方案

edgeMoves <- function(e) {
  umoves <- sapply(ends(graph = g, es = e), neighbors, graph = g, mode = "all", simplify = FALSE)
  do.call(paste, c(expand.grid(mapply(function(x, y) 
    paste(x, names(y), sep =" to "), ends(graph = g, es = e), umoves, SIMPLIFY = FALSE)), sep = ", "))
}
edgeConstraints <- function(e) {
  v <- ends(graph = g, es = e)
  n1 <- names(neighbors(g, v[1], mode = "all"))
  n2 <- names(neighbors(g, v[2], mode = "all"))
  t(cbind(sapply(n2, function(nn2) moves %in% paste0(v[1], " to ", n1, ", ", v[2], " to ", nn2)),
          sapply(n1, function(nn1) moves %in% paste0(v[1], " to ", nn1, ", ", v[2], " to ", n2))))
}
moves <- do.call(c, sapply(E(g), edgeMoves))
moves
# [1] "1 to 3, 3 to 1" "1 to 4, 3 to 1" "1 to 3, 3 to 2"
# [4] "1 to 4, 3 to 2" "1 to 3, 4 to 1" "1 to 4, 4 to 1"
# [7] "3 to 1, 2 to 3" "3 to 2, 2 to 3"

do.call(rbind, sapply(E(g), edgeConstraints)) * 1
#   [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# 1    1    1    0    0    0    0    0    0
# 2    0    0    1    1    0    0    0    0
# 3    1    0    1    0    0    0    0    0
# 4    0    1    0    1    0    0    0    0
# 1    0    0    0    0    1    1    0    0
# 3    0    0    0    0    1    0    0    0
# 4    0    0    0    0    0    1    0    0
# 3    0    0    0    0    0    0    1    1
# 1    0    0    0    0    0    0    1    0
# 2    0    0    0    0    0    0    0    1

行顺序不同，但我怀疑它不是问题。另外，对于单个边缘，您可以使用edgeMoves(e)和edgeConstraints(e) * 1。