Question

我想在没有欧拉循环的图表中解决中国邮递员问题。所以基本上我在图中寻找一条路径，它只访问每个边缘一次，并在同一节点开始和结束。当且仅当每个节点具有相同数量的边进入和离开时，图将具有欧拉循环。显然我的图表没有。

我发现Eulerization（制作图Eulerian）可以解决我的问题LINK。任何人都可以建议一个脚本向图形添加重复的边缘，以便结果图形没有奇数度的顶点（因此有一个欧拉电路）？

以下是我的例子：

require(igraph)
require(graph)
require(eulerian)
require(GA)
g1 <- graph(c(1,2, 1,3, 2,4, 2,5, 1,5, 3,5, 4,7, 5,7, 5,8, 3,6, 6,8, 6,9, 9,11, 8,11, 8,10, 8,12, 7,10, 10,12, 11,12), directed = FALSE)
mat <- get.adjacency(g1)
mat <- as.matrix(mat)
rownames(mat) <- LETTERS[1:12]
colnames(mat) <- LETTERS[1:12]
g2 <- as(graphAM(adjMat=mat), "graphNEL")
hasEulerianCycle(g2)

Answer 1

有趣的问题。

您在上面的代码中获取的图表可以制作重复项，以便创建欧洲循环。我在下面提供的函数尝试添加最少量的重复边，但如果必须，还可以通过添加新链接来轻松破坏图形结构。

你可以运行：

eulerian.g1 <- make.eulerian(g1)$graph

使用以下命令检查函数对图表的作用：

make.eulerian(g1)$info

请记住：

这不是唯一的图表结构，其中添加到原始g1图表的重复项可以形成欧洲循环。想象一下，例如我的函数向后循环图形的顶点。
您的图形已经具有不均匀度的顶点数量不均匀，并且所有顶点都具有不均匀度的邻居以与它们配对。因此，此功能可以很好地适用于您的特定示例数据。
即使在可以正确添加重复的欧拉循环的图形中，该函数也可能无法仅使用重复生成图形。这是因为它总是将节点与其邻居的第一个节点连接在一起。如果这是你绝对想要解决的问题，那么采用MCMC方法将是最佳选择。

另见this关于概率计算的优秀答案：

这是我在完整脚本中的功能，您可以开箱即用：

library(igraph)

# You asked about this graph
g1 <- graph(c(1,2, 1,3, 2,4, 2,5, 1,5, 3,5, 4,7, 5,7, 5,8, 3,6, 6,8, 6,9, 9,11, 8,11, 8,10, 8,12, 7,10, 10,12, 11,12), directed = FALSE)

# Make a CONNECTED random graph with at least n nodes
connected.erdos.renyi.game <- function(n,m){
       graph <- erdos.renyi.game(n,m,"gnm",directed=FALSE)
       graph <- delete_vertices(graph, (degree(graph) == 0))
}

# This is a random graph
g2 <- connected.erdos.renyi.game(n=12, m=16)



make.eulerian <- function(graph){
       # Carl Hierholzer (1873) had explained how eulirian cycles exist for graphs that are
       # 1) connected, and 2) contain only vertecies with even degrees. Based on this proof
       # the posibility of an eulerian cycle existing in a graph can be tested by testing
       # on these two conditions.
       #
       # This function assumes a connected graph.
       # It adds edges to a graph to ensure that all nodes eventuall has an even numbered. It 
       # tries to maintain the structure of the graph by primarily adding duplicates of already
       # existing edges, but can also add "structurally new" edges if the structure of the 
       # graph does not allow.

       # save output
       info <- c("broken" = FALSE, "Added" = 0, "Successfull" = TRUE)

       # Is a number even
       is.even <- function(x){ x %% 2 == 0 }

       # Graphs with an even number of verticies with uneven degree will more easily converge
       # as eulerian.
       # Should we even out the number of unevenly degreed verticies?
       search.for.even.neighbor <- !is.even(sum(!is.even(degree(graph))))

       # Loop to add edges but never to change nodes that have been set to have even degree
       for(i in V(graph)){
              set.j <- NULL

              #neighbors of i with uneven number of edges are good candidates for new edges
              uneven.neighbors <- !is.even(degree(graph, neighbors(graph,i)))

              if(!is.even(degree(graph,i))){
                     # This node needs a new connection. That edge e(i,j) needs an appropriate j:

                     if(sum(uneven.neighbors) == 0){
                            # There is no neighbor of i that has uneven degree. We will 
                            # have to break the graph structure and connect nodes that
                            # were not connected before:

                            if(sum(!is.even(degree(graph))) > 0){
                                   # Only break the structure if it's absolutely nessecary
                                   # to force the graph into a structure where an euclidian
                                   # cycle exists:
                                   info["Broken"] <- TRUE

                                   # Find candidates for j amongst any unevenly degreed nodes
                                   uneven.candidates <- !is.even(degree(graph, V(graph)))

                                   # Sugest a new edge between i and any node with uneven degree
                                   if(sum(uneven.candidates) != 0){
                                          set.j <- V(graph)[uneven.candidates][[1]]
                                   }else{
                                          # No candidate with uneven degree exists!

                                          # If all edges except the last have even degrees, thith
                                          # function will fail to make the graph eulerian:
                                          info["Successfull"] <- FALSE
                                   }
                            }

                     }else{
                            # A "structurally duplicated" edge may be formed between i one of
                            # the nodes of uneven degree that is already connected to it.

                            # Sugest a new edge between i and its first neighbor with uneven degree
                            set.j <- neighbors(graph, i)[uneven.neighbors][[1]]
                     }
              }else if(search.for.even.neighbor == TRUE & is.null(set.j)){
                     # This only happens once (probably) in the beginning of the loop of
                     # treating graphs that have an uneven number of verticies with uneven
                     # degree. It creates a duplicate between a node and one of its evenly
                     # degreed neighbors (if possible)
                     info["Added"] <- info["Added"] + 1

                     set.j <- neighbors(graph, i)[ !uneven.neighbors ][[1]]
                     # Never do this again if a j is correctly set
                     if(!is.null(set.j)){search.for.even.neighbor <- FALSE}
              }

              # Add that a new edge to alter degrees in the desired direction
              # OBS: as.numeric() since set.j might be NULL
              if(!is.null(set.j)){
                     # i may not link to j
                     if(i != set.j){
                            graph <- add_edges(graph, edges=c(i, set.j))
                            info["Added"] <- info["Added"] + 1
                     }
              }
       }

       # return the graph
       (list("graph" = graph, "info" = info))
}

# Look at what we did
eulerian <- make.eulerian(g1)
eulerian$info
g <- eulerian$graph

par(mfrow=c(1,2))
plot(g1)
plot(g)

用eulerization解决中国邮递员算法

1 个答案: