view release on metacpan or  search on metacpan

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

       || $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();