view release on metacpan or  search on metacpan

lib/Algorithm/CriticalPath.pm  view on Meta::CPAN

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__



=head1 SYNOPSIS

Performs a critical path analysis of a DAG where the vertices have costs, and the edges do not.
All costs are assumed positive.  Dummy Start and End nodes are used internally to aid the analysis.

The constructor takes a pre-constructed Graph object with weighted vertices and simple directed edges.  The Graph object is embedded
in the Algorithm::CriticalPath object as a readonly attribute, and cannot be updated once the Algorithm::CriticalPath object has been constructed.