Maybe this question is too hard. So I try to make a simple version to research.
Simulating a simple graph than that post.
SeedRandom[2]
p = RandomReal[1, {20, 2}];
sortPoint[p_] :=
Module[{order = Last[FindShortestTour[p]]},
If[RandomReal[] < .5, p[[Rest[order]]], p[[order]]]]
Graphics[line = Line /@ sortPoint /@ FindClusters[p, 5]]
Make it to be a graph
rule = Dispatch[MapIndexed[Rule[#, First[#2]] &, p]];
g = Graph[
Catenate[Developer`PartitionMap[UndirectedEdge @@ # &, #, 2, 1] & /@
Level[line /. rule, {2}]],
VertexCoordinates -> Reverse /@ Normal[rule]]
Add some additional edges between components each other
gLast = Fold[
GraphUnion[#, #2, VertexCoordinates -> Reverse /@ Normal[rule],
VertexLabels -> "Name"] &, g,
Graph[UndirectedEdge @@@ Tuples[#]] & /@
Subsets[ConnectedComponents[g], {2}]]
To make sure we can select these edge we want,we should make some essential variables.
var = Rule[addEdge @@ #, #] & /@
Complement[EdgeList@gLast, EdgeList@g];
weightRule =
Rule[#, EuclideanDistance @@ (# /. Reverse /@ Normal[rule])] & /@
Complement[EdgeList@gLast, EdgeList@g];
var2 = connectQ @@@ Keys[var];
But obviously the method of nikie's don't give integer always.
sol = Last[
FindMinimum[{(Values[var] /. weightRule).var2,
And @@ Thread[0 <= var2 <= 1] &&
And @@ Thread[
Total /@
Function[ind, Select[ind, MemberQ[var2, #] &]] /@
Apply[connectQ,
IncidenceList[gLast, #] & /@
ConnectedComponents[g], {2}] == 1]}, var2]];
As we see the result,we get some 0.5,neither 0 nor 1.But when we give a constraint such Element[var2, Integers]
.It will give some error information.
Values[sol] // Counts
<|1. -> 1, 0. -> 153, 0.5 -> 3|>
I think if we can solve this equation then the process in following become easy.Of course,if you have another smart solution,I'll glad to know.:)
ps: The result picture maybe like following.Of course,this is just an approximate guess.