File Coverage

blib/lib/Algorithm/CriticalPath.pm

Criterion	Covered	Total	%
statement	65	65	100.0
branch	6	6	100.0
condition	16	18	88.8
subroutine	6	6	100.0
pod	1	1	100.0
total	94	96	97.9

package Algorithm::CriticalPath;

use 5.010;
use Mouse;



=head1 NAME

Algorithm::CriticalPath - Perform a critical path analysis over a Graph Object, by Ded MedVed

=head1 VERSION

Version 0.07

=cut

our $VERSION = '0.07';


use Graph;
use Carp;
use Data::Dumper;

has 'graph' => (
    is              => 'ro'
,   isa             => 'Graph'
,   required        => 1
);

has 'vertices' => (
    is  => 'rw'
,   isa => 'ArrayRef[Str]'
);
has 'cost' => (
    is  => 'rw'
,   isa => 'Num'
);


sub BUILD {

    my ($self) = @_;

    if (  ! defined $self->graph()
       || $self->graph()->has_a_cycle()
       || $self->graph()->is_pseudo_graph()
       || $self->graph()->is_refvertexed()
       || $self->graph()->is_undirected()
       || $self->graph()->is_multiedged()
       || $self->graph()->is_multivertexed()
       )
       {
        croak 'Invalid graph type for critical path analysis' ;
       } ;

    # this is ropey - should use guaranteed unique names
    my $start = 'GCP::dummyStart';
    my $end   = 'GCP::dummyEnd';


    # this is ropey, should use a BFS search method to return the depth-ordered rankings of vertices.
    my $g = $self->graph()->deep_copy();
    my @rank;
    my $i = 0 ;
    while ( $g->vertices() > 0 ) {

        @{$rank[$i]} = $g->source_vertices();
        push @{$rank[$i]}, $g->isolated_vertices();

        for my $s (@{$rank[$i]})  {
            $g->delete_vertex($s);
        }
        $i++;
    }

    # $copy adds in the dummy start and end nodes, so we don't destroy the original.
    my $copy = $self->graph()->deep_copy();
    $copy->add_weighted_vertex($start,0);
    $copy->add_weighted_vertex($end,0);

    for my $n ($copy->source_vertices()) {
        $copy->add_edge($start, $n);
    }
    for my $n ($copy->sink_vertices()) {
        $copy->add_edge($n,$end);
    }

    for my $n ($copy->isolated_vertices()) {
        $copy->add_edge($start, $n);
        $copy->add_edge($n,$end);
    }

    unshift @rank, [$start];
    push    @rank, [$end];

    my %costToHere = map { $_ => 0 } $copy->vertices();

    my %criticalPathToHere;
    $criticalPathToHere{$start} = [$start];

    for my $row ( @rank ) {
        for my $node ( @$row ) {
            for my $s ( $copy->successors($node) ) {
                if ( $costToHere{$node} + $copy->get_vertex_weight($s) > $costToHere{$s} ) {
                    $costToHere{$s}                     = $costToHere{$node} + $copy->get_vertex_weight($s);
                    @{$criticalPathToHere{$s}}          = @{$criticalPathToHere{$node}};
                    push @{$criticalPathToHere{$s}}, $s;
                }
            }
        }
    }

    # we don't want to see the dummy nodes on the returned critical path.
    @{$criticalPathToHere{$end}} = grep { $_ ne ${start} && $_ ne ${end} } @{$criticalPathToHere{$end}} ;

    $self->vertices(\@{$criticalPathToHere{$end}});
    $self->cost($costToHere{$end});


} ;

__PACKAGE__->meta->make_immutable();


1;
__DATA__