File Coverage

blib/lib/Graph/Kruskal.pm

Criterion	Covered	Total	%
statement	9	133	6.7
branch	0	28	0.0
condition	0	12	0.0
subroutine	3	12	25.0
pod	0	9	0.0
total	12	194	6.1

#  Copyright (c) 1995, 1996, 1997 by Steffen Beyer. All rights reserved.
#  This package is free software; you can redistribute it and/or modify
#  it under the same terms as Perl itself.

package Graph::Kruskal;

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
            $number_of_edges $number_of_vortices @V @E @T);

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw(define_vortices define_edges
                heapify makeheap heapsort
                find union kruskal example);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

$VERSION = '2.0';

use Carp;

$number_of_vortices = 0;
$number_of_edges = 0;

sub example
{
    my($costs) = 0;
    my($k);

    print "\n";
    print "+++ Kruskal's Algorithm for Minimal Spanning Trees in Graphs +++";
    print "\n";

    &define_vortices(2,3,5,7,11,13,17,19,23,29,31);

    print "\nVortices:\n\n";

    for ( $k = 1; $k <= $#V; ++$k )
    {
        if (defined $V[$k]) { print "$k\n"; }
    }

    &define_edges( 2,13,3, 3,13,2, 5,13,1, 3,5,2, 3,29,21, 23,29,3,
     23,31,2, 5,31,15, 5,7,10, 2,11,2, 7,11,2, 7,19,5, 11,19,2,
     7,31,4, 3,17,3, 17,23,3, 7,17,3 );

    print "\nEdges:\n\n";

    for ( $k = 1; $k <= $#E; ++$k )
    {
        print ${$E[$k]}{'from'}, " <-> ", ${$E[$k]}{'to'}, " = ",
            ${$E[$k]}{'cost'}, "\n";
    }

    &kruskal();

    print "\nEdges in minimal spanning tree:\n\n";

    for ( $k = 1; $k <= $#T; ++$k )
    {
        print ${$T[$k]}{'from'}, " <-> ", ${$T[$k]}{'to'}, " = ",
            ${$T[$k]}{'cost'}, "\n";
        $costs += ${$T[$k]}{'cost'};
    }

    print "\nTotal costs: $costs\n\n";
}

sub define_vortices
{
    undef @V;
    $number_of_vortices = 0;
    foreach (@_)
    {
        ($_ > 0) || croak "Graph::Kruskal::define_vortices(): vortex number not positive\n";
        $V[$_] = -1;
        ++$number_of_vortices;
    }
}

sub define_edges
{
    my($from,$to,$cost);

    undef @E;
    $number_of_edges = 0;
    while (@_)
    {
        $from = shift || croak "Graph::Kruskal::define_edges(): missing 'from' vortex number\n";
        $to   = shift || croak "Graph::Kruskal::define_edges(): missing 'to' vortex number\n";
        $cost = shift || croak "Graph::Kruskal::define_edges(): missing edge 'cost' value\n";
        defined $V[$from] || croak "Graph::Kruskal::define_edges(): vortex '$from' not previously defined\n";
        defined $V[$to]   || croak "Graph::Kruskal::define_edges(): vortex '$to' not previously defined\n";
        ($from != $to)    || croak "Graph::Kruskal::define_edges(): vortices 'from' and 'to' are the same\n";
        $E[++$number_of_edges] =
            { 'from' => $from, 'to' => $to, 'cost' => $cost };
    }
}

sub heapify             # complexity: O(ld n)
{
    my($i,$n) = @_;
    my($i2,$i21,$j,$swap);

    while ($i < $n)
    {
        $j   = $i;
        $i2  = $i * 2;
        $i21 = $i2 + 1;
        if ($i2 <= $n)
        {
            if (${$E[$i]}{'cost'} > ${$E[$i2]}{'cost'})
            {
                $j = $i2;
                if ($i21 <= $n)
                {
                    if (${$E[$i2]}{'cost'} > ${$E[$i21]}{'cost'}) { $j = $i21; }
                }
            }
            else
            {
                if ($i21 <= $n)
                {
                    if (${$E[$i]}{'cost'} > ${$E[$i21]}{'cost'}) { $j = $i21; }
                }
            }
        }
        if ($i != $j)
        {
            $swap  = $E[$i];
            $E[$i] = $E[$j];
            $E[$j] = $swap;
            $i = $j;
        }
        else { $i = $n; }
    }
}

sub makeheap            # complexity: O(n ld n)
{
    my($n) = @_;
    my($k);

    for ( $k = $n - 1; $k > 0; --$k ) { &heapify($k, $n); }
}

# The following subroutine isn't used by this algorithm, it is only included
# here for the sake of completeness:

sub heapsort            # complexity: O(n ld n)
{
    my($n) = @_;
    my($k,$swap);

    for ( $k = $n - 1; $k > 0; --$k ) { &heapify($k, $n); }

    for ( $k = $n; $k > 1; --$k )
    {
        $swap  = $E[1];
        $E[1]  = $E[$k];
        $E[$k] = $swap;
        &heapify(1, $k - 1);
    }
}

sub find
{
    my($i) = @_;
    my($j,$k,$t);

    $j = $i;
    while ($V[$j] > 0) { $j = $V[$j]; } # find root element (= set identifier)
    $k = $i;
    while ($k != $j)                    # height compression of the tree
    {
        $t = $V[$k];
        $V[$k] = $j;
        $k = $t;
    }
    return($j);
}

sub union
{
    my($i,$j) = @_;
    my($x);

    $x = $V[$i] + $V[$j];    # calculate number of elements in resulting set
    if ($V[$i] > $V[$j])     # which of the two sets contains more elements?
    {
        $V[$i] = $j;         # merge them
        $V[$j] = $x;         # update number of elements
    }
    else
    {
        $V[$j] = $i;         # merge them
        $V[$i] = $x;         # update number of elements
    }
}

sub kruskal             # complexity: O(n ld n)   ( where n := |{ Edges }| )
{
    my($n) = $number_of_edges;
    my($v) = $number_of_vortices;
    my($i,$j,$swap);
    my($t) = 0;

    undef @T;
    &makeheap($number_of_edges);        # complexity: O(n ld n)
    while (($v > 1) && ($n > 0))
    {
        $swap  = $E[1];
        $E[1]  = $E[$n];
        $E[$n] = $swap;
        &heapify(1, $n - 1);            # complexity: n O(ld n) = O(n ld n)
        $i = find(${$E[$n]}{'from'});   # complexity: n ( 2 find + 1 union ) =
        $j = find(${$E[$n]}{'to'});     #             O( G(n) n ) <= O(n ld n)
        if ($i != $j)
        {
            union($i,$j);
            $T[++$t] = $E[$n];
            --$v;
        }
        --$n;
    }
    return(@T);
}

1;

__END__