#!/usr/local/bin/perl5.8.2 -w
use strict;
use Test::More tests => 5;
BEGIN {
    use_ok('Graph::Directed');
}

# returns a graph cointaining all vertices that are in one
# or more cycles.

sub cycles {
    my $G = shift;
    my $H = $G->copy;
    return reduce_to_cycles($H);
}

# reduce_to_cycles() modifies the input graph, use cycles() to make
# a copy first.

sub reduce_to_cycles {
    my $G = shift;
    while ($G->vertices) {
# get the 'end' vertices
        my @ends = grep { ! $G->out_edges($_) or ! $G->in_edges($_) } 
+$G->vertices; 
        if (@ends) {
# remove 'end' vertices, and repeat
            $G->delete_vertices(@ends);
            next;
        }
        else {
# Graph is not empty, but also has no end vertices
# any more, so we're left with cycles...
            return $G;     
        }
    }
    return $G;
}   

# tests

my $G = Graph::Directed->new;
is(cycles($G)->vertices,0,"Empty graph");

$G->add_vertices('a' .. 'b');

is(cycles($G)->vertices,0,"No edges");

my $last = 'd';
for ('a' .. 'd') {
    $G->add_edge($last,$_);
    $last = $_;
}
is(cycles($G)->vertices,4,"Square");


$G->add_edges('e','a','d','f'); # one 'pointing in' and one 'pointing 
+out'
is(cycles($G)->vertices,4,"End points");
[download]