用欧化方法求解中国邮递员算法

Question

我想在一个不存在欧拉圈的图中解决中国邮递员问题。基本上，我在图中寻找一条路径，它精确地访问每条边一次，并在同一节点开始和结束。一个图将有一个欧拉圈当且仅当每个节点都有相同数目的边进入和离开它。显然我的图表没有。

我发现欧拉化(欧拉图)可以解决我的问题链接。有人能建议脚本向图中添加重复的边，这样得到的图就没有奇数度的顶点(因此也有Euler电路)吗？

以下是我的例子：

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

切记：

1. 这并不是添加到原始g1图中的重复项可以形成欧拉循环的唯一图形结构。例如，想象一下我的函数将图的顶点向后循环。
2. 你的图已经有一个不均匀的不均匀度的顶点数，所有的顶点都有不均匀度的邻域来对它们。因此，这个函数可以很好地工作--您的特定示例数据。
3. 该函数可能无法生成只使用重复的图，即使在欧拉圈可以正确添加重复的图中也是如此。这是因为它总是将节点与其第一个不均匀程度的邻居连接起来。如果这是你绝对想要得到的东西，MCMC-方法将是最好的方法。

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

下面是我在一个完整脚本中的函数，您可以从这个脚本中找到现成的源代码：

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)