#!/usr/bin/perl

# _union_vertex_set
#
#       $G->_union_vertex_set($u, $v)
#
#       (INTERNAL USE ONLY)
#       Adds the vertices $u and $v in the graph $G to the same vertex set.
#
sub _union_vertex_set {
    my ($G, $u, $v) = @_;

    my $su = $G->vertex_set( $u );
    my $sv = $G->vertex_set( $v );
    my $ru = $G->{ VertexSetRank }->{ $su };
    my $rv = $G->{ VertexSetRank }->{ $sv };

    if ( $ru < $rv ) {  # Union by rank (weight balancing).
        $G->{ VertexSetParent }->{ $su } = $sv;
    } else {
        $G->{ VertexSetParent }->{ $sv } = $su;
        $G->{ VertexSetRank   }->{ $sv }++ if $ru == $rv;
    }
}

# vertex_set
#
#       $s = $G->vertex_set($v)
#
#       Returns the vertex set of the vertex $v in the graph $G.
#       A "vertex set" is represented by its parent vertex.
#
sub vertex_set {
    my ($G, $v) = @_;

    if ( exists  $G->{ VertexSetParent }->{ $v } ) {
        # Path compression.
        $G->{ VertexSetParent }->{ $v } =
          $G->vertex_set( $G->{ VertexSetParent }->{ $v } )
            if $v ne $G->{ VertexSetParent }->{ $v };
    } else {
        $G->{ VertexSetParent }->{ $v } = $v;

        $G->{ VertexSetRank   }->{ $v } = 0;
    }

    return $G->{ VertexSetParent }->{ $v };
}

# MST_Kruskal
#
#       $MST = $G->MST_Kruskal;
#
#       Returns Kruskal's Minimum Spanning Tree (as a graph) of
#       the graph $G based on the 'weight' attributes of the edges.
#       (Needs the vertex_set() method,
#       and add_edge() needs a _union_vertex_set().)
#
sub MST_Kruskal {
    my $G   = shift;
    my $MST = (ref $G)->new;
    my @E   = $G->edges;
    my (@W, $u, $v, $w);

    while (($u, $v) = splice(@E, 0, 2)) {
        $w = $G->get_attribute('weight', $u, $v);
        next unless defined $w; # undef weight == infinitely heavy
        push @W, [ $u, $v, $w ];
    }

    $MST->directed( $G->directed );

    # Sort by weights.
    foreach my $e ( sort { $a->[ 2 ] <=> $b->[ 2 ] } @W ) {
        ($u, $v, $w) = @$e;
        $MST->add_weighted_edge( $u, $w, $v )
            unless $MST->vertex_set( $u ) eq $MST->vertex_set( $v );
    }

    return $MST;
}

# MST_Prim
#
#       $MST = $G->MST_Prim($s)
#
#       Returns Prim's Minimum Spanning Tree (as a graph) of
#       the graph $G based on the 'weight' attributes of the edges.
#       The optional start vertex is $s; if none is given, a hopefully
#       good one (a vertex with a large out degree) is chosen.
#

sub MST_Prim {
    my ( $G, $s ) = @_;
    my $MST       = (ref $G)->new;

    $u = $G->largest_out_degree( $G->vertices ) unless defined $u;

    use Heap::Fibonacci;
    my $heap = Heap::Fibonacci->new;
    my ( %in_heap, %weight, %parent );

    $G->_heap_init( $heap, $s, \%in_heap, \%weight, \%parent );

    # Walk the edges at the current BFS front
    # in the order of their increasing weight.
    while ( defined $heap->minimum ) {
        my $u = $heap->extract_minimum;
        delete $in_heap{ $u->vertex };

        # Now extend the BFS front.

        foreach my $v ( $G->successors( $u->vertex ) ) {
            if ( defined( $v = $in_heap{ $v } ) ) {
                my $nw = $G->get_attribute( 'weight',
                                            $u->vertex, $v->vertex );
                my $ow = $v->weight;

                if ( not defined $ow or $nw < $ow ) {
                    $v->weight( $nw );
                    $v->parent( $u->vertex );
                    $heap->decrease_key( $v );
                }
            }
        }
    }

    foreach my $v ( $G->vertices ) {
        $MST->add_weighted_edge( $v, $weight{ $v }, $parent{ $v } )
            if defined $parent{ $v };
    }

    return $MST;
}

use Graph;

my $graph = Graph->new;

# add_weighted_path() is defined using add_path()
# and set_attribute('weight', ...).
$graph->add_weighted_path( qw( a 4 b 1 c 2 f 3 i 2 h 1 g 2 d 1 a ) );
$graph->add_weighted_path( qw( a 3 e 6 i ) );
$graph->add_weighted_path( qw( d 1 e 2 f ) );
$graph->add_weighted_path( qw( b 2 e 5 h ) );
$graph->add_weighted_path( qw( e 1 g ) );
$graph->add_weighted_path( qw( b 1 f ) );

my $mst_kruskal = $graph->MST_Kruskal;
my $mst_prim    = $graph->MST_Prim;

print "Kruskal MST: $mst_kruskal\n";
print "Prim MST: $mst_prim\n";