#!/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");