15.4.775  src/lib/graph/kruskal.pkg

# Compiled by:
#     src/lib/graph/graphs.lib

# This module implements Kruskal's algorithm for minimal cost
# spanning tree.
#
# -- Allen Leung



#                "Hacking, like love, like music,
#                 has the power to make men happy."



stipulate
    package odg =  oop_digraph;                                         # oop_digraph                   is from   src/lib/graph/oop-digraph.pkg
    package np  =  node_partition;                                      # node_partition                is from   src/lib/graph/node-partition.pkg
    package lpq =  leftist_tree_priority_queue;                         # leftist_tree_priority_queue   is from   src/lib/src/leftist-tree-priority-queue.pkg
herein

    package kruskals_minimum_cost_spanning_tree
    : (weak)         Minimal_Cost_Spanning_Tree                         # Minimal_Cost_Spanning_Tree    is from   src/lib/graph/spanning-tree.api
    {
        exception UNCONNECTED;

        fun spanning_tree { weight, lt } (odg as odg::DIGRAPH dig) add_edge u
            =
            {   fun less (e1, e2)
                    =
                    lt (weight e1, weight e2);

                pq =   lpq::make_priority_queue  less; 

                dig.forall_edges (lpq::set pq); 

                p =   np::node_partition odg;


                fun make_tree (1, u)
                        =>
                        u;

                    make_tree (mmm, u)
                        =>
                        {   (lpq::delete_min  pq)
                                ->
                                e as (i, j, _);

                            if (np::(====) p (i, j))
                                #
                                make_tree (mmm, u);
                            else
                                np::union' p (i, j);
                                make_tree (mmm - 1, add_edge (e, u));
                            fi;
                        };
                end;

                make_tree (dig.order (), u);
            }
            except
                lpq::EMPTY_PRIORITY_QUEUE =  raise exception UNCONNECTED;
    };
end;