Computing  Minimum  Spanning  Trees

A set of 7 points

points1={{0.197908,0.580628},{0.907652,0.429974},{0.241306,0.0168272},{0.579112,0.409649},{0.13649,0.839228},{0.419112,0.989533},{0.716089,0.309559}};
ListPlot[points1->Range[Length[points1]],PlotRange->{{0,1},{0,1}},AspectRatio->1]

A set of 10 points

points2={{0.702318,0.979279},{0.290985,0.268894},{0.665485,0.0880937},{0.439554,0.823236},{0.656158,0.98592},{0.861857,0.5128},{0.323303,0.115716},{0.114107,0.717454},{0.99706,0.99026},{0.948522,0.355205}};

ListPlot[points2->Range[Length[points2]],PlotRange->{{0,1},{0,1}},AspectRatio->1]

A set of 25 points

points3={{0.590153,0.958057},{0.858411,0.535645},{0.790052,0.819207},{0.750252,0.293361},{0.816713,0.397825},{0.876402,0.865534},{0.412268,0.37832},{0.363073,0.849829},{0.178223,0.250366},{0.0591027,0.817491},{0.527368,0.338961},{0.646758,0.818539},{0.163101,0.342767},{0.574564,0.0987882},{0.394098,0.215297},{0.911302,0.269034},{0.866134,0.130799},{0.436155,0.788419},{0.974625,0.346871},{0.000217897,0.877632},{0.313519,0.908292},{0.165577,0.395166},{0.91908,0.523492},{0.990984,0.181202},{0.962271,0.818646}};

ListPlot[points3->Range[Length[points3]],PlotRange->{{0,1},{0,1}},AspectRatio->1]

Kruskal's  Algorithm

Compute a minimum spanning tree for points1:

points1

n=Length[points1]

Define all edges between these points

edges=Subsets[Range[n],{2}]

Demo of using Map to convert edges (by indexes) to coordinates

Map[points1[[#]]&,{1,2}]

Now sort edges by Euclidean distance between points. Note that @@ is shorthand for the Apply function.

edges=SortBy[edges,EuclideanDistance@@points1[[#]]&]

Compute the minimum spanning tree. Note that @@@ is shorthand for the MapApply function, which we use to replace each ordered pair of indexes with an undirected edge.

(* initialize an empty list to hold the minimum spanning tree *)
mst={};

(* loop over all edges, starting with the shortest *)
Do[
Print["considering edge",edge];

(* check whether this edge forms a cycle with the edges currently in the mst *) 
cycle=FindCycle[UndirectedEdge@@@Union[mst,{edge}]];
Print[cycle];

(* if this edges does NOT form a cycle, then append it to the mst *) 
If[cycle=={},AppendTo[mst,edge]];
Print["MST:",mst]

,{edge,edges}]

Here is the minimum spanning tree:

mst

We didn’t have time to draw the minimum spanning tree in class today, but here is the graph:

graphPlot=Graph[UndirectedEdge@@@mst,VertexCoordinates->Table[i->points1[[i]],{i,1,n}]];
pointPlot=ListPlot[points1->Range[n],PlotRange->{{0,1},{0,1}},AspectRatio->1];
Show[pointPlot,graphPlot]

Now compute a minimum spanning tree for points2:

Here is a condensed version of the code:

(* specify the list of points and the number of points *) 
points=points2;
n=Length[points];

(* build the set of all edges (that is, pairs of vertex indexes) and sort them by length *) 
edges=Subsets[Range[n],{2}];
edges=SortBy[edges,EuclideanDistance@@points[[#]]&];

(* initialize an empty list to hold the minimum spanning tree *)
mst={};

(* loop over all edges, starting with the shortest *)
Do[
(*Print["considering edge",edge];*)

(* check whether this edge forms a cycle with the edges currently in the mst *) 
cycle=FindCycle[UndirectedEdge@@@Union[mst,{edge}]];
(*Print[cycle];*)

(* if this edges does NOT form a cycle, then append it to the mst *) 
If[cycle=={},AppendTo[mst,edge]];
(*Print["MST:",mst]*)
,{edge,edges}] 

(* print the minimum spanning tree *) 
mst

graphPlot=Graph[UndirectedEdge@@@mst,VertexCoordinates->Table[i->points[[i]],{i,1,n}]];
pointPlot=ListPlot[points->Range[n],PlotRange->{{0,1},{0,1}},AspectRatio->1];
Show[pointPlot,graphPlot]

Next compute a minimum spanning tree for points3:

Here is a condensed version of the code:

points=points3;
n=Length[points];
edges=Subsets[Range[n],{2}];
edges=SortBy[edges,EuclideanDistance@@points[[#]]&];
mst={};
Do[
(*Print["considering edge",edge];*)
cycle=FindCycle[UndirectedEdge@@@Union[mst,{edge}]];
(*Print[cycle];*)
If[cycle=={},AppendTo[mst,edge]];
(*Print["MST:",mst]*)
,{edge,edges}] (* loop over all edges, starting with the shortest *)
mst

graphPlot=Graph[UndirectedEdge@@@mst,VertexCoordinates->Table[i->points[[i]],{i,1,n}]];
pointPlot=ListPlot[points->Range[n],PlotRange->{{0,1},{0,1}},AspectRatio->1];
Show[pointPlot,graphPlot]

Computational Complexity Note

Our implementation of Kruskal’s algorithm is not optimal due to our use of the FindCycle function. An optimal implementation would use a disjoint set data structure to track the connected components and determine whether each edge forms a cycle.