Create a Perl library directory, and add the Graph module to it

Graph-0.84 from CPAN

1 files changed, 3851 insertions, 0 deletions

diff --git a/perllib/Graph.pm b/perllib/Graph.pm
new file mode 100644
index 0000000..3d1ad33
--- /dev/null
+++ b/perllib/Graph.pm
@@ -0,0 +1,3851 @@
+package Graph;
+
+use strict;
+
+BEGIN {
+    if (0) { # SET THIS TO ZERO FOR TESTING AND RELEASES!
+	$SIG{__DIE__ } = \&__carp_confess;
+	$SIG{__WARN__} = \&__carp_confess;
+    }
+    sub __carp_confess { require Carp; Carp::confess(@_) }
+}
+
+use Graph::AdjacencyMap qw(:flags :fields);
+
+use vars qw($VERSION);
+
+$VERSION = '0.84';
+
+require 5.006; # Weak references are absolutely required.
+
+use Graph::AdjacencyMap::Heavy;
+use Graph::AdjacencyMap::Light;
+use Graph::AdjacencyMap::Vertex;
+use Graph::UnionFind;
+use Graph::TransitiveClosure;
+use Graph::Traversal::DFS;
+use Graph::MSTHeapElem;
+use Graph::SPTHeapElem;
+use Graph::Undirected;
+
+use Heap071::Fibonacci;
+use List::Util qw(shuffle first);
+use Scalar::Util qw(weaken);
+
+sub _F () { 0 } # Flags.
+sub _G () { 1 } # Generation.
+sub _V () { 2 } # Vertices.
+sub _E () { 3 } # Edges.
+sub _A () { 4 } # Attributes.
+sub _U () { 5 } # Union-Find.
+
+my $Inf;
+
+BEGIN {
+    local $SIG{FPE}; 
+    eval { $Inf = exp(999) } ||
+	eval { $Inf = 9**9**9 } ||
+	    eval { $Inf = 1e+999 } ||
+		{ $Inf = 1e+99 };  # Close enough for most practical purposes.
+}
+
+sub Infinity () { $Inf }
+
+# Graphs are blessed array references.
+# - The first element contains the flags.
+# - The second element is the vertices.
+# - The third element is the edges.
+# - The fourth element is the attributes of the whole graph.
+# The defined flags for Graph are:
+# - _COMPAT02 for user API compatibility with the Graph 0.20xxx series.
+# The vertices are contained in either a "simplemap"
+# (if no hypervertices) or in a "map".
+# The edges are always in a "map".
+# The defined flags for maps are:
+# - _COUNT for countedness: more than one instance
+# - _HYPER for hyperness: a different number of "coordinates" than usual;
+#   expects one for vertices and two for edges
+# - _UNORD for unordered coordinates (a set): if _UNORD is not set
+#   the coordinates are assumed to be meaningfully ordered
+# - _UNIQ for unique coordinates: if set duplicates are removed,
+#   if not, duplicates are assumed to meaningful
+# - _UNORDUNIQ: just a union of _UNORD and UNIQ
+# Vertices are assumed to be _UNORDUNIQ; edges assume none of these flags.
+
+use Graph::Attribute array => _A, map => 'graph';
+
+sub _COMPAT02 () { 0x00000001 }
+
+sub stringify {
+    my $g = shift;
+    my $o = $g->is_undirected;
+    my $e = $o ? '=' : '-';
+    my @e =
+	map {
+	    my @v =
+		map {
+		    ref($_) eq 'ARRAY' ? "[" . join(" ", @$_) . "]" : "$_"
+		}
+	    @$_;
+	    join($e, $o ? sort { "$a" cmp "$b" } @v : @v) } $g->edges05;
+    my @s = sort { "$a" cmp "$b" } @e;
+    push @s, sort { "$a" cmp "$b" } $g->isolated_vertices;
+    join(",", @s);
+}
+
+sub eq {
+    "$_[0]" eq "$_[1]"
+}
+
+sub ne {
+    "$_[0]" ne "$_[1]"
+}
+
+use overload
+    '""' => \&stringify,
+    'eq' => \&eq,
+    'ne' => \≠
+
+sub _opt {
+    my ($opt, $flags, %flags) = @_;
+    while (my ($flag, $FLAG) = each %flags) {
+	if (exists $opt->{$flag}) {
+	    $$flags |= $FLAG if $opt->{$flag};
+	    delete $opt->{$flag};
+	}
+	if (exists $opt->{my $non = "non$flag"}) {
+	    $$flags &= ~$FLAG if $opt->{$non};
+	    delete $opt->{$non};
+	}
+    }
+}
+
+sub is_compat02 {
+    my ($g) = @_;
+    $g->[ _F ] & _COMPAT02;
+}
+
+*compat02 = \&is_compat02;
+
+sub has_union_find {
+    my ($g) = @_;
+    ($g->[ _F ] & _UNIONFIND) && defined $g->[ _U ];
+}
+
+sub _get_union_find {
+    my ($g) = @_;
+    $g->[ _U ];
+}
+
+sub _opt_get {
+    my ($opt, $key, $var) = @_;
+    if (exists $opt->{$key}) {
+	$$var = $opt->{$key};
+	delete $opt->{$key};
+    }
+}
+
+sub _opt_unknown {
+    my ($opt) = @_;
+    if (my @opt = keys %$opt) {
+	my $f = (caller(1))[3];
+	require Carp;
+	Carp::confess(sprintf
+		      "$f: Unknown option%s: @{[map { qq['$_'] } sort @opt]}",
+		      @opt > 1 ? 's' : '');
+    }
+}
+
+sub new {
+    my $class = shift;
+    my $gflags = 0;
+    my $vflags;
+    my $eflags;
+    my %opt = _get_options( \@_ );
+
+    if (ref $class && $class->isa('Graph')) {
+	no strict 'refs';
+        for my $c (qw(undirected refvertexed compat02
+                      hypervertexed countvertexed multivertexed
+                      hyperedged countedged multiedged omniedged)) {
+#            $opt{$c}++ if $class->$c; # 5.00504-incompatible
+	    if (&{"Graph::$c"}($class)) { $opt{$c}++ }
+        }
+#        $opt{unionfind}++ if $class->has_union_find; # 5.00504-incompatible
+	if (&{"Graph::has_union_find"}($class)) { $opt{unionfind}++ }
+    }
+
+    _opt_get(\%opt, undirected   => \$opt{omniedged});
+    _opt_get(\%opt, omnidirected => \$opt{omniedged});
+
+    if (exists $opt{directed}) {
+	$opt{omniedged} = !$opt{directed};
+	delete $opt{directed};
+    }
+
+    my $vnonomni =
+	$opt{nonomnivertexed} ||
+	    (exists $opt{omnivertexed} && !$opt{omnivertexed});
+    my $vnonuniq =
+	$opt{nonuniqvertexed} ||
+	    (exists $opt{uniqvertexed} && !$opt{uniqvertexed});
+
+    _opt(\%opt, \$vflags,
+	 countvertexed	=> _COUNT,
+	 multivertexed	=> _MULTI,
+	 hypervertexed	=> _HYPER,
+	 omnivertexed	=> _UNORD,
+	 uniqvertexed	=> _UNIQ,
+	 refvertexed	=> _REF,
+	);
+
+    _opt(\%opt, \$eflags,
+	 countedged	=> _COUNT,
+	 multiedged	=> _MULTI,
+	 hyperedged	=> _HYPER,
+	 omniedged	=> _UNORD,
+	 uniqedged	=> _UNIQ,
+	);
+
+    _opt(\%opt, \$gflags,
+	 compat02      => _COMPAT02,
+	 unionfind     => _UNIONFIND,
+	);
+
+    if (exists $opt{vertices_unsorted}) { # Graph 0.20103 compat.
+	my $unsorted = $opt{vertices_unsorted};
+	delete $opt{vertices_unsorted};
+	require Carp;
+	Carp::confess("Graph: vertices_unsorted must be true")
+	    unless $unsorted;
+    }
+
+    my @V;
+    if ($opt{vertices}) {
+	require Carp;
+	Carp::confess("Graph: vertices should be an array ref")
+	    unless ref $opt{vertices} eq 'ARRAY';
+	@V = @{ $opt{vertices} };
+	delete $opt{vertices};
+    }
+
+    my @E;
+    if ($opt{edges}) {
+	unless (ref $opt{edges} eq 'ARRAY') {
+	    require Carp;
+	    Carp::confess("Graph: edges should be an array ref of array refs");
+	}
+	@E = @{ $opt{edges} };
+	delete $opt{edges};
+    }
+
+    _opt_unknown(\%opt);
+
+    my $uflags;
+    if (defined $vflags) {
+	$uflags = $vflags;
+	$uflags |= _UNORD unless $vnonomni;
+	$uflags |= _UNIQ  unless $vnonuniq;
+    } else {
+	$uflags = _UNORDUNIQ;
+	$vflags = 0;
+    }
+
+    if (!($vflags & _HYPER) && ($vflags & _UNORDUNIQ)) {
+	my @but;
+	push @but, 'unordered' if ($vflags & _UNORD);
+	push @but, 'unique'    if ($vflags & _UNIQ);
+	require Carp;
+	Carp::confess(sprintf "Graph: not hypervertexed but %s",
+		      join(' and ', @but));
+    }
+
+    unless (defined $eflags) {
+	$eflags = ($gflags & _COMPAT02) ? _COUNT : 0;
+    }
+
+    if (!($vflags & _HYPER) && ($vflags & _UNIQ)) {
+	require Carp;
+	Carp::confess("Graph: not hypervertexed but uniqvertexed");
+    }
+
+    if (($vflags & _COUNT) && ($vflags & _MULTI)) {
+	require Carp;
+	Carp::confess("Graph: both countvertexed and multivertexed");
+    }
+
+    if (($eflags & _COUNT) && ($eflags & _MULTI)) {
+	require Carp;
+	Carp::confess("Graph: both countedged and multiedged");
+    }
+
+    my $g = bless [ ], ref $class || $class;
+
+    $g->[ _F ] = $gflags;
+    $g->[ _G ] = 0;
+    $g->[ _V ] = ($vflags & (_HYPER | _MULTI)) ?
+	Graph::AdjacencyMap::Heavy->_new($uflags, 1) :
+	    (($vflags & ~_UNORD) ?
+	     Graph::AdjacencyMap::Vertex->_new($uflags, 1) :
+	     Graph::AdjacencyMap::Light->_new($g, $uflags, 1));
+    $g->[ _E ] = (($vflags & _HYPER) || ($eflags & ~_UNORD)) ?
+	Graph::AdjacencyMap::Heavy->_new($eflags, 2) :
+	    Graph::AdjacencyMap::Light->_new($g, $eflags, 2);
+
+    $g->add_vertices(@V) if @V;
+
+    if (@E) {
+	for my $e (@E) {
+	    unless (ref $e eq 'ARRAY') {
+		require Carp;
+		Carp::confess("Graph: edges should be array refs");
+	    }
+	    $g->add_edge(@$e);
+	}
+    }
+
+    if (($gflags & _UNIONFIND)) {
+	$g->[ _U ] = Graph::UnionFind->new;
+    }
+
+    return $g;
+}
+
+sub countvertexed { $_[0]->[ _V ]->_is_COUNT }
+sub multivertexed { $_[0]->[ _V ]->_is_MULTI }
+sub hypervertexed { $_[0]->[ _V ]->_is_HYPER }
+sub omnivertexed  { $_[0]->[ _V ]->_is_UNORD }
+sub uniqvertexed  { $_[0]->[ _V ]->_is_UNIQ  }
+sub refvertexed   { $_[0]->[ _V ]->_is_REF   }
+
+sub countedged    { $_[0]->[ _E ]->_is_COUNT }
+sub multiedged    { $_[0]->[ _E ]->_is_MULTI }
+sub hyperedged    { $_[0]->[ _E ]->_is_HYPER }
+sub omniedged     { $_[0]->[ _E ]->_is_UNORD }
+sub uniqedged     { $_[0]->[ _E ]->_is_UNIQ  }
+
+*undirected   = \&omniedged;
+*omnidirected = \&omniedged;
+sub directed { ! $_[0]->[ _E ]->_is_UNORD }
+
+*is_directed      = \&directed;
+*is_undirected    = \&undirected;
+
+*is_countvertexed = \&countvertexed;
+*is_multivertexed = \&multivertexed;
+*is_hypervertexed = \&hypervertexed;
+*is_omnidirected  = \&omnidirected;
+*is_uniqvertexed  = \&uniqvertexed;
+*is_refvertexed   = \&refvertexed;
+
+*is_countedged    = \&countedged;
+*is_multiedged    = \&multiedged;
+*is_hyperedged    = \&hyperedged;
+*is_omniedged     = \&omniedged;
+*is_uniqedged     = \&uniqedged;
+
+sub _union_find_add_vertex {
+    my ($g, $v) = @_;
+    my $UF = $g->[ _U ];
+    $UF->add( $g->[ _V ]->_get_path_id( $v ) );
+}
+
+sub add_vertex {
+    my $g = shift;
+    if ($g->is_multivertexed) {
+	return $g->add_vertex_by_id(@_, _GEN_ID);
+    }
+    my @r;
+    if (@_ > 1) {
+	unless ($g->is_countvertexed || $g->is_hypervertexed) {
+	    require Carp;
+	    Carp::croak("Graph::add_vertex: use add_vertices for more than one vertex or use hypervertexed");
+	}
+	for my $v ( @_ ) {
+	    if (defined $v) {
+		$g->[ _V ]->set_path( $v ) unless $g->has_vertex( $v );
+	    } else {
+		require Carp;
+		Carp::croak("Graph::add_vertex: undef vertex");
+	    }
+	}
+    }
+    for my $v ( @_ ) {
+	unless (defined $v) {
+	    require Carp;
+	    Carp::croak("Graph::add_vertex: undef vertex");
+	}
+    }
+    $g->[ _V ]->set_path( @_ );
+    $g->[ _G ]++;
+    $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
+    return $g;
+}
+
+sub has_vertex {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    return exists $V->[ _s ]->{ $_[0] } if ($V->[ _f ] & _LIGHT);
+    $V->has_path( @_ );
+}
+
+sub vertices05 {
+    my $g = shift;
+    my @v = $g->[ _V ]->paths( @_ );
+    if (wantarray) {
+	return $g->[ _V ]->_is_HYPER ?
+	    @v : map { ref $_ eq 'ARRAY' ? @$_ : $_ } @v;
+    } else {
+	return scalar @v;
+    }
+}
+
+sub vertices {
+    my $g = shift;
+    my @v = $g->vertices05;
+    if ($g->is_compat02) {
+        wantarray ? sort @v : scalar @v;
+    } else {
+	if ($g->is_multivertexed || $g->is_countvertexed) {
+	    if (wantarray) {
+		my @V;
+		for my $v ( @v ) {
+		    push @V, ($v) x $g->get_vertex_count($v);
+		}
+		return @V;
+	    } else {
+		my $V = 0;
+		for my $v ( @v ) {
+		    $V += $g->get_vertex_count($v);
+		}
+		return $V;
+	    }
+	} else {
+	    return @v;
+	}
+    }
+}
+
+*vertices_unsorted = \&vertices_unsorted; # Graph 0.20103 compat.
+
+sub unique_vertices {
+    my $g = shift;
+    my @v = $g->vertices05;
+    if ($g->is_compat02) {
+        wantarray ? sort @v : scalar @v;
+    } else {
+	return @v;
+    }
+}
+
+sub has_vertices {
+    my $g = shift;
+    scalar $g->[ _V ]->has_paths( @_ );
+}
+
+sub _add_edge {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my @e;
+    if (($V->[ _f ]) & _LIGHT) {
+	for my $v ( @_ ) {
+	    $g->add_vertex( $v ) unless exists $V->[ _s ]->{ $v };
+	    push @e, $V->[ _s ]->{ $v };
+	}
+    } else {
+	my $h = $g->[ _V ]->_is_HYPER;
+	for my $v ( @_ ) {
+	    my @v = ref $v eq 'ARRAY' && $h ? @$v : $v;
+	    $g->add_vertex( @v ) unless $V->has_path( @v );
+	    push @e, $V->_get_path_id( @v );
+	}
+    }
+    return @e;
+}
+
+sub _union_find_add_edge {
+    my ($g, $u, $v) = @_;
+    $g->[ _U ]->union($u, $v);
+}
+
+sub add_edge {
+    my $g = shift;
+    if ($g->is_multiedged) {
+	unless (@_ == 2 || $g->is_hyperedged) {
+	    require Carp;
+	    Carp::croak("Graph::add_edge: use add_edges for more than one edge");
+	}
+	return $g->add_edge_by_id(@_, _GEN_ID);
+    }
+    unless (@_ == 2) {
+	unless ($g->is_hyperedged) {
+	    require Carp;
+	    Carp::croak("Graph::add_edge: graph is not hyperedged");
+	}
+    }
+    my @e = $g->_add_edge( @_ );
+    $g->[ _E ]->set_path( @e );
+    $g->[ _G ]++;
+    $g->_union_find_add_edge( @e ) if $g->has_union_find;
+    return $g;
+}
+
+sub _vertex_ids {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my @e;
+    if (($V->[ _f ] & _LIGHT)) {
+	for my $v ( @_ ) {
+	    return () unless exists $V->[ _s ]->{ $v };
+	    push @e, $V->[ _s ]->{ $v };
+	}
+    } else {
+	my $h = $g->[ _V ]->_is_HYPER;
+	for my $v ( @_ ) {
+	    my @v = ref $v eq 'ARRAY' && $h ? @$v : $v;
+	    return () unless $V->has_path( @v );
+	    push @e, $V->_get_path_id( @v );
+	}
+    }
+    return @e;
+}
+
+sub has_edge {
+    my $g = shift;
+    my $E = $g->[ _E ];
+    my $V = $g->[ _V ];
+    my @i;
+    if (($V->[ _f ] & _LIGHT) && @_ == 2) {
+	return 0 unless
+	    exists $V->[ _s ]->{ $_[0] } &&
+	    exists $V->[ _s ]->{ $_[1] };
+	@i = @{ $V->[ _s ] }{ @_[ 0, 1 ] };
+    } else {
+	@i = $g->_vertex_ids( @_ );
+	return 0 if @i == 0 && @_;
+    }
+    my $f = $E->[ _f ];
+    if ($E->[ _a ] == 2 && @i == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
+	@i = sort @i if ($f & _UNORD);
+	return exists $E->[ _s ]->{ $i[0] } &&
+	       exists $E->[ _s ]->{ $i[0] }->{ $i[1] } ? 1 : 0;
+    } else {
+	return defined $E->_get_path_id( @i ) ? 1 : 0;
+    }
+}
+
+sub edges05 {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my @e = $g->[ _E ]->paths( @_ );
+    wantarray ?
+	map { [ map { my @v = $V->_get_id_path($_);
+		      @v == 1 ? $v[0] : [ @v ] }
+		@$_ ] }
+            @e : @e;
+}
+
+sub edges02 {
+    my $g = shift;
+    if (@_ && defined $_[0]) {
+	unless (defined $_[1]) {
+	    my @e = $g->edges_at($_[0]);
+	    wantarray ?
+		map { @$_ }
+                    sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @e
+                : @e;
+	} else {
+	    die "edges02: unimplemented option";
+	}
+    } else {
+	my @e = map { ($_) x $g->get_edge_count(@$_) } $g->edges05( @_ );
+	wantarray ?
+          map { @$_ }
+              sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @e
+          : @e;
+    }
+}
+
+sub unique_edges {
+    my $g = shift;
+    ($g->is_compat02) ? $g->edges02( @_ ) : $g->edges05( @_ );
+}
+
+sub edges {
+    my $g = shift;
+    if ($g->is_compat02) {
+	return $g->edges02( @_ );
+    } else {
+	if ($g->is_multiedged || $g->is_countedged) {
+	    if (wantarray) {
+		my @E;
+		for my $e ( $g->edges05 ) {
+		    push @E, ($e) x $g->get_edge_count(@$e);
+		}
+		return @E;
+	    } else {
+		my $E = 0;
+		for my $e ( $g->edges05 ) {
+		    $E += $g->get_edge_count(@$e);
+		}
+		return $E;
+	    }
+	} else {
+	    return $g->edges05;
+	}
+    }
+}
+
+sub has_edges {
+    my $g = shift;
+    scalar $g->[ _E ]->has_paths( @_ );
+}
+
+###
+# by_id
+#
+
+sub add_vertex_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->[ _V ]->set_path_by_multi_id( @_ );
+    $g->[ _G ]++;
+    $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
+    return $g;
+}
+
+sub add_vertex_get_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $id = $g->[ _V ]->set_path_by_multi_id( @_, _GEN_ID );
+    $g->[ _G ]++;
+    $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
+    return $id;
+}
+
+sub has_vertex_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->[ _V ]->has_path_by_multi_id( @_ );
+}
+
+sub delete_vertex_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $V = $g->[ _V ];
+    return unless $V->has_path_by_multi_id( @_ );
+    # TODO: what to about the edges at this vertex?
+    # If the multiness of this vertex goes to zero, delete the edges?
+    $V->del_path_by_multi_id( @_ );
+    $g->[ _G ]++;
+    return $g;
+}
+
+sub get_multivertex_ids {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->[ _V ]->get_multi_ids( @_ );
+}
+
+sub add_edge_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $id = pop;
+    my @e = $g->_add_edge( @_ );
+    $g->[ _E ]->set_path( @e, $id );
+    $g->[ _G ]++;
+    $g->_union_find_add_edge( @e ) if $g->has_union_find;
+    return $g;
+}
+
+sub add_edge_get_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my @i = $g->_add_edge( @_ );
+    my $id = $g->[ _E ]->set_path_by_multi_id( @i, _GEN_ID );
+    $g->_union_find_add_edge( @i ) if $g->has_union_find;
+    $g->[ _G ]++;
+    return $id;
+}
+
+sub has_edge_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $id = pop;
+    my @i = $g->_vertex_ids( @_ );
+    return 0 if @i == 0 && @_;
+    $g->[ _E ]->has_path_by_multi_id( @i, $id );
+}
+
+sub delete_edge_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $V = $g->[ _E ];
+    my $id = pop;
+    my @i = $g->_vertex_ids( @_ );
+    return unless $V->has_path_by_multi_id( @i, $id );
+    $V->del_path_by_multi_id( @i, $id );
+    $g->[ _G ]++;
+    return $g;
+}
+
+sub get_multiedge_ids {
+    my $g = shift;
+    $g->expect_multiedged;
+    my @id = $g->_vertex_ids( @_ );
+    return unless @id;
+    $g->[ _E ]->get_multi_ids( @id );
+}
+
+###
+# Neighbourhood.
+#
+
+sub vertices_at {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    return @_ unless ($V->[ _f ] & _HYPER);
+    my %v;
+    my @i;
+    for my $v ( @_ ) {
+	my $i = $V->_get_path_id( $v );
+	return unless defined $i;
+	push @i, ( $v{ $v } = $i );
+    }
+    my $Vi = $V->_ids;
+    my @v;
+    while (my ($i, $v) = each %{ $Vi }) {
+	my %i;
+	my $h = $V->[_f ] & _HYPER;
+	@i{ @i } = @i if @i; # @todo: nonuniq hyper vertices?
+	for my $u (ref $v eq 'ARRAY' && $h ? @$v : $v) {
+	    my $j = exists $v{ $u } ? $v{ $u } : ( $v{ $u } = $i );
+	    if (defined $j && exists $i{ $j }) {
+		delete $i{ $j };
+		unless (keys %i) {
+		    push @v, $v;
+		    last;
+		}
+	    }
+	}
+    }
+    return @v;
+}
+
+sub _edges_at {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my $E = $g->[ _E ];
+    my @e;
+    my $en = 0;
+    my %ev;
+    my $h = $V->[_f ] & _HYPER;
+    for my $v ( $h ? $g->vertices_at( @_ ) : @_ ) {
+	my $vi = $V->_get_path_id( ref $v eq 'ARRAY' && $h ? @$v : $v );
+	next unless defined $vi;
+	my $Ei = $E->_ids;
+	while (my ($ei, $ev) = each %{ $Ei }) {
+	    if (wantarray) {
+		for my $j (@$ev) {
+		    push @e, [ $ei, $ev ]
+			if $j == $vi && !$ev{$ei}++;
+		}
+	    } else {
+		for my $j (@$ev) {
+		    $en++ if $j == $vi;
+		}
+	    }		    
+	}
+    }
+    return wantarray ? @e : $en;
+}
+
+sub _edges_from {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my $E = $g->[ _E ];
+    my @e;
+    my $o = $E->[ _f ] & _UNORD;
+    my $en = 0;
+    my %ev;
+    my $h = $V->[_f ] & _HYPER;
+    for my $v ( $h ? $g->vertices_at( @_ ) : @_ ) {
+	my $vi = $V->_get_path_id( ref $v eq 'ARRAY' && $h ? @$v : $v );
+	next unless defined $vi;
+	my $Ei = $E->_ids;
+	if (wantarray) {
+	    if ($o) {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    push @e, [ $ei, $ev ]
+			if ($ev->[0] == $vi || $ev->[-1] == $vi) && !$ev{$ei}++;
+		}
+	    } else {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    push @e, [ $ei, $ev ]
+			if $ev->[0] == $vi && !$ev{$ei}++;
+		}
+	    }
+	} else {
+	    if ($o) {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    $en++ if ($ev->[0] == $vi || $ev->[-1] == $vi);
+		}
+	    } else {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    $en++ if $ev->[0] == $vi;
+		}
+	    }
+	}
+    }
+    if (wantarray && $g->is_undirected) {
+	my @i = map { $V->_get_path_id( $_ ) } @_;
+	for my $e ( @e ) {
+	    unless ( $e->[ 1 ]->[ 0 ] == $i[ 0 ] ) { # @todo
+		$e = [ $e->[ 0 ], [ reverse @{ $e->[ 1 ] } ] ];
+	    }
+	}
+    }
+    return wantarray ? @e : $en;
+}
+
+sub _edges_to {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    my $E = $g->[ _E ];
+    my @e;
+    my $o = $E->[ _f ] & _UNORD;
+    my $en = 0;
+    my %ev;
+    my $h = $V->[_f ] & _HYPER;
+    for my $v ( $h ? $g->vertices_at( @_ ) : @_ ) {
+	my $vi = $V->_get_path_id( ref $v eq 'ARRAY' && $h ? @$v : $v );
+	next unless defined $vi;
+	my $Ei = $E->_ids;
+	if (wantarray) {
+	    if ($o) {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    push @e, [ $ei, $ev ]
+			if ($ev->[-1] == $vi || $ev->[0] == $vi) && !$ev{$ei}++;
+		}
+	    } else {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    push @e, [ $ei, $ev ]
+			if $ev->[-1] == $vi && !$ev{$ei}++;
+		}
+	    }
+	} else {
+	    if ($o) {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    $en++ if $ev->[-1] == $vi || $ev->[0] == $vi;
+		}
+	    } else {
+		while (my ($ei, $ev) = each %{ $Ei }) {
+		    next unless @$ev;
+		    $en++ if $ev->[-1] == $vi;
+		}
+	    }
+	}
+    }
+    if (wantarray && $g->is_undirected) {
+	my @i = map { $V->_get_path_id( $_ ) } @_;
+	for my $e ( @e ) {
+	    unless ( $e->[ 1 ]->[ -1 ] == $i[ -1 ] ) { # @todo
+		$e = [ $e->[ 0 ], [ reverse @{ $e->[ 1 ] } ] ];
+	    }
+	}
+    }
+    return wantarray ? @e : $en;
+}
+
+sub _edges_id_path {
+    my $g = shift;
+    my $V  = $g->[ _V ];
+    [ map { my @v = $V->_get_id_path($_);
+	    @v == 1 ? $v[0] : [ @v ] }
+          @{ $_[0]->[1] } ];
+}
+
+sub edges_at {
+    my $g = shift;
+    map { $g->_edges_id_path($_ ) } $g->_edges_at( @_ );
+}
+
+sub edges_from {
+    my $g = shift;
+    map { $g->_edges_id_path($_ ) } $g->_edges_from( @_ );
+}
+
+sub edges_to {
+    my $g = shift;
+    map { $g->_edges_id_path($_ ) } $g->_edges_to( @_ );
+}
+
+sub successors {
+    my $g = shift;
+    my $E = $g->[ _E ];
+    ($E->[ _f ] & _LIGHT) ?
+	$E->_successors($g, @_) :
+	Graph::AdjacencyMap::_successors($E, $g, @_);
+}
+
+sub predecessors {
+    my $g = shift;
+    my $E = $g->[ _E ];
+    ($E->[ _f ] & _LIGHT) ?
+	$E->_predecessors($g, @_) :
+	Graph::AdjacencyMap::_predecessors($E, $g, @_);
+}
+
+sub neighbours {
+    my $g = shift;
+    my $V  = $g->[ _V ];
+    my @s = map { my @v = @{ $_->[ 1 ] }; shift @v; @v } $g->_edges_from( @_ );
+    my @p = map { my @v = @{ $_->[ 1 ] }; pop   @v; @v } $g->_edges_to  ( @_ );
+    my %n;
+    @n{ @s } = @s;
+    @n{ @p } = @p;
+    map { $V->_get_id_path($_) } keys %n;
+}
+
+*neighbors = \&neighbours;
+
+sub delete_edge {
+    my $g = shift;
+    my @i = $g->_vertex_ids( @_ );
+    return $g unless @i;
+    my $i = $g->[ _E ]->_get_path_id( @i );
+    return $g unless defined $i;
+    $g->[ _E ]->_del_id( $i );
+    $g->[ _G ]++;
+    return $g;
+}
+
+sub delete_vertex {
+    my $g = shift;
+    my $V = $g->[ _V ];
+    return $g unless $V->has_path( @_ );
+    my $E = $g->[ _E ];
+    for my $e ( $g->_edges_at( @_ ) ) {
+	$E->_del_id( $e->[ 0 ] );
+    }
+    $V->del_path( @_ );
+    $g->[ _G ]++;
+    return $g;
+}
+
+sub get_vertex_count {
+    my $g = shift;
+    $g->[ _V ]->_get_path_count( @_ ) || 0;
+}
+
+sub get_edge_count {
+    my $g = shift;
+    my @e = $g->_vertex_ids( @_ );
+    return 0 unless @e;
+    $g->[ _E ]->_get_path_count( @e ) || 0;
+}
+
+sub delete_vertices {
+    my $g = shift;
+    while (@_) {
+	my $v = shift @_;
+	$g->delete_vertex($v);
+    }
+    return $g;
+}
+
+sub delete_edges {
+    my $g = shift;
+    while (@_) {
+	my ($u, $v) = splice @_, 0, 2;
+	$g->delete_edge($u, $v);
+    }
+    return $g;
+}
+
+###
+# Degrees.
+#
+
+sub _in_degree {
+    my $g = shift;
+    return undef unless @_ && $g->has_vertex( @_ );
+    my $in =  $g->is_undirected && $g->is_self_loop_vertex( @_ ) ? 1 : 0;
+    $in += $g->get_edge_count( @$_ ) for $g->edges_to( @_ );
+    return $in;
+}
+
+sub in_degree {
+    my $g = shift;
+    $g->_in_degree( @_ );
+}
+
+sub _out_degree {
+    my $g = shift;
+    return undef unless @_ && $g->has_vertex( @_ );
+    my $out =  $g->is_undirected && $g->is_self_loop_vertex( @_ ) ? 1 : 0;
+    $out += $g->get_edge_count( @$_ ) for $g->edges_from( @_ );
+    return $out;
+}
+
+sub out_degree {
+    my $g = shift;
+    $g->_out_degree( @_ );
+}
+
+sub _total_degree {
+    my $g = shift;
+    return undef unless @_ && $g->has_vertex( @_ );
+    $g->is_undirected ?
+	$g->_in_degree( @_ ) :
+	$g-> in_degree( @_ ) - $g-> out_degree( @_ );
+}
+
+sub degree {
+    my $g = shift;
+    if (@_) {
+	$g->_total_degree( @_ );
+    } else {
+	if ($g->is_undirected) {
+	    my $total = 0;
+	    $total += $g->_total_degree( $_ ) for $g->vertices05;
+	    return $total;
+	} else {
+	    return 0;
+	}
+    }
+}
+
+*vertex_degree = \&degree;
+
+sub is_sink_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->successors( @_ ) == 0 && $g->predecessors( @_ ) > 0;
+}
+
+sub is_source_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->predecessors( @_ ) == 0 && $g->successors( @_ ) > 0;
+}
+
+sub is_successorless_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->successors( @_ ) == 0;
+}
+
+sub is_predecessorless_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->predecessors( @_ ) == 0;
+}
+
+sub is_successorful_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->successors( @_ ) > 0;
+}
+
+sub is_predecessorful_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->predecessors( @_ ) > 0;
+}
+
+sub is_isolated_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->predecessors( @_ ) == 0 && $g->successors( @_ ) == 0;
+}
+
+sub is_interior_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    my $p = $g->predecessors( @_ );
+    my $s = $g->successors( @_ );
+    if ($g->is_self_loop_vertex( @_ )) {
+	$p--;
+	$s--;
+    }
+    $p > 0 && $s > 0;
+}
+
+sub is_exterior_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    $g->predecessors( @_ ) == 0 || $g->successors( @_ ) == 0;
+}
+
+sub is_self_loop_vertex {
+    my $g = shift;
+    return 0 unless @_;
+    for my $s ( $g->successors( @_ ) ) {
+	return 1 if $s eq $_[0]; # @todo: hypervertices
+    }
+    return 0;
+}
+
+sub sink_vertices {
+    my $g = shift;
+    grep { $g->is_sink_vertex($_) } $g->vertices05;
+}
+
+sub source_vertices {
+    my $g = shift;
+    grep { $g->is_source_vertex($_) } $g->vertices05;
+}
+
+sub successorless_vertices {
+    my $g = shift;
+    grep { $g->is_successorless_vertex($_) } $g->vertices05;
+}
+
+sub predecessorless_vertices {
+    my $g = shift;
+    grep { $g->is_predecessorless_vertex($_) } $g->vertices05;
+}
+
+sub successorful_vertices {
+    my $g = shift;
+    grep { $g->is_successorful_vertex($_) } $g->vertices05;
+}
+
+sub predecessorful_vertices {
+    my $g = shift;
+    grep { $g->is_predecessorful_vertex($_) } $g->vertices05;
+}
+
+sub isolated_vertices {
+    my $g = shift;
+    grep { $g->is_isolated_vertex($_) } $g->vertices05;
+}
+
+sub interior_vertices {
+    my $g = shift;
+    grep { $g->is_interior_vertex($_) } $g->vertices05;
+}
+
+sub exterior_vertices {
+    my $g = shift;
+    grep { $g->is_exterior_vertex($_) } $g->vertices05;
+}
+
+sub self_loop_vertices {
+    my $g = shift;
+    grep { $g->is_self_loop_vertex($_) } $g->vertices05;
+}
+
+###
+# Paths and cycles.
+#
+
+sub add_path {
+    my $g = shift;
+    my $u = shift;
+    while (@_) {
+	my $v = shift;
+	$g->add_edge($u, $v);
+	$u = $v;
+    }
+    return $g;
+}
+
+sub delete_path {
+    my $g = shift;
+    my $u = shift;
+    while (@_) {
+	my $v = shift;
+	$g->delete_edge($u, $v);
+	$u = $v;
+    }
+    return $g;
+}
+
+sub has_path {
+    my $g = shift;
+    my $u = shift;
+    while (@_) {
+	my $v = shift;
+	return 0 unless $g->has_edge($u, $v);
+	$u = $v;
+    }
+    return $g;
+}
+
+sub add_cycle {
+    my $g = shift;
+    $g->add_path(@_, $_[0]);
+}
+
+sub delete_cycle {
+    my $g = shift;
+    $g->delete_path(@_, $_[0]);
+}
+
+sub has_cycle {
+    my $g = shift;
+    @_ ? ($g->has_path(@_, $_[0]) ? 1 : 0) : 0;
+}
+
+sub has_a_cycle {
+    my $g = shift;
+    my @r = ( back_edge => \&Graph::Traversal::has_a_cycle );
+    push @r,
+      down_edge => \&Graph::Traversal::has_a_cycle
+       if $g->is_undirected;
+    my $t = Graph::Traversal::DFS->new($g, @r, @_);
+    $t->dfs;
+    return $t->get_state('has_a_cycle');
+}
+
+sub find_a_cycle {
+    my $g = shift;
+    my @r = ( back_edge => \&Graph::Traversal::find_a_cycle);
+    push @r,
+      down_edge => \&Graph::Traversal::find_a_cycle
+	if $g->is_undirected;
+    my $t = Graph::Traversal::DFS->new($g, @r, @_);
+    $t->dfs;
+    $t->has_state('a_cycle') ? @{ $t->get_state('a_cycle') } : ();
+}
+
+###
+# Attributes.
+
+# Vertex attributes.
+
+sub set_vertex_attribute {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $value = pop;
+    my $attr  = pop;
+    $g->add_vertex( @_ ) unless $g->has_vertex( @_ );
+    $g->[ _V ]->_set_path_attr( @_, $attr, $value );
+}
+
+sub set_vertex_attribute_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $value = pop;
+    my $attr  = pop;
+    $g->add_vertex_by_id( @_ ) unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_set_path_attr( @_, $attr, $value );
+}
+
+sub set_vertex_attributes {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $attr = pop;
+    $g->add_vertex( @_ ) unless $g->has_vertex( @_ );
+    $g->[ _V ]->_set_path_attrs( @_, $attr );
+}
+
+sub set_vertex_attributes_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $attr = pop;
+    $g->add_vertex_by_id( @_ ) unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_set_path_attrs( @_, $attr );
+}
+
+sub has_vertex_attributes {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    return 0 unless $g->has_vertex( @_ );
+    $g->[ _V ]->_has_path_attrs( @_ );
+}
+
+sub has_vertex_attributes_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    return 0 unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_has_path_attrs( @_ );
+}
+
+sub has_vertex_attribute {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $attr = pop;
+    return 0 unless $g->has_vertex( @_ );
+    $g->[ _V ]->_has_path_attr( @_, $attr );
+}
+
+sub has_vertex_attribute_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $attr = pop;
+    return 0 unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_has_path_attr( @_, $attr );
+}
+
+sub get_vertex_attributes {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    return unless $g->has_vertex( @_ );
+    my $a = $g->[ _V ]->_get_path_attrs( @_ );
+    ($g->is_compat02) ? (defined $a ? %{ $a } : ()) : $a;
+}
+
+sub get_vertex_attributes_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    return unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_get_path_attrs( @_ );
+}
+
+sub get_vertex_attribute {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $attr = pop;
+    return unless $g->has_vertex( @_ );
+    $g->[ _V ]->_get_path_attr( @_, $attr );
+}
+
+sub get_vertex_attribute_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $attr = pop;
+    return unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_get_path_attr( @_, $attr );
+}
+
+sub get_vertex_attribute_names {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    return unless $g->has_vertex( @_ );
+    $g->[ _V ]->_get_path_attr_names( @_ );
+}
+
+sub get_vertex_attribute_names_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    return unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_get_path_attr_names( @_ );
+}
+
+sub get_vertex_attribute_values {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    return unless $g->has_vertex( @_ );
+    $g->[ _V ]->_get_path_attr_values( @_ );
+}
+
+sub get_vertex_attribute_values_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    return unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_get_path_attr_values( @_ );
+}
+
+sub delete_vertex_attributes {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    return undef unless $g->has_vertex( @_ );
+    $g->[ _V ]->_del_path_attrs( @_ );
+}
+
+sub delete_vertex_attributes_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    return undef unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_del_path_attrs( @_ );
+}
+
+sub delete_vertex_attribute {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $attr = pop;
+    return undef unless $g->has_vertex( @_ );
+    $g->[ _V ]->_del_path_attr( @_, $attr );
+}
+
+sub delete_vertex_attribute_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $attr = pop;
+    return undef unless $g->has_vertex_by_id( @_ );
+    $g->[ _V ]->_del_path_attr( @_, $attr );
+}
+
+# Edge attributes.
+
+sub _set_edge_attribute {
+    my $g = shift;
+    my $value = pop;
+    my $attr  = pop;
+    my $E = $g->[ _E ];
+    my $f = $E->[ _f ];
+    my @i;
+    if ($E->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
+	@_ = sort @_ if ($f & _UNORD);
+	my $s = $E->[ _s ];
+	$g->add_edge( @_ ) unless exists $s->{ $_[0] } && exists $s->{ $_[0] }->{ $_[1] };
+	@i = @{ $g->[ _V ]->[ _s ] }{ @_ };
+    } else {
+	$g->add_edge( @_ ) unless $g->has_edge( @_ );
+	@i = $g->_vertex_ids( @_ );
+    }
+    $g->[ _E ]->_set_path_attr( @i, $attr, $value );
+}
+
+sub set_edge_attribute {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $value = pop;
+    my $attr  = pop;
+    my $E = $g->[ _E ];
+    $g->add_edge( @_ ) unless $g->has_edge( @_ );
+    $E->_set_path_attr( $g->_vertex_ids( @_ ), $attr, $value );
+}
+
+sub set_edge_attribute_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $value = pop;
+    my $attr  = pop;
+    # $g->add_edge_by_id( @_ ) unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_set_path_attr( $g->_vertex_ids( @_ ), $id, $attr, $value );
+}
+
+sub set_edge_attributes {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $attr = pop;
+    $g->add_edge( @_ ) unless $g->has_edge( @_ );
+    $g->[ _E ]->_set_path_attrs( $g->_vertex_ids( @_ ), $attr );
+}
+
+sub set_edge_attributes_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $attr = pop;
+    $g->add_edge_by_id( @_ ) unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_set_path_attrs( $g->_vertex_ids( @_ ), $id, $attr );
+}
+
+sub has_edge_attributes {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    return 0 unless $g->has_edge( @_ );
+    $g->[ _E ]->_has_path_attrs( $g->_vertex_ids( @_ ) );
+}
+
+sub has_edge_attributes_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    return 0 unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_has_path_attrs( $g->_vertex_ids( @_ ), $id );
+}
+
+sub has_edge_attribute {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $attr = pop;
+    return 0 unless $g->has_edge( @_ );
+    $g->[ _E ]->_has_path_attr( $g->_vertex_ids( @_ ), $attr );
+}
+
+sub has_edge_attribute_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $attr = pop;
+    return 0 unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_has_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
+}
+
+sub get_edge_attributes {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    return unless $g->has_edge( @_ );
+    my $a = $g->[ _E ]->_get_path_attrs( $g->_vertex_ids( @_ ) );
+    ($g->is_compat02) ? (defined $a ? %{ $a } : ()) : $a;
+}
+
+sub get_edge_attributes_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    return $g->[ _E ]->_get_path_attrs( $g->_vertex_ids( @_ ), $id );
+}
+
+sub _get_edge_attribute { # Fast path; less checks.
+    my $g = shift;
+    my $attr = pop;
+    my $E = $g->[ _E ];
+    my $f = $E->[ _f ];
+    if ($E->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
+	@_ = sort @_ if ($f & _UNORD);
+	my $s = $E->[ _s ];
+	return unless exists $s->{ $_[0] } && exists $s->{ $_[0] }->{ $_[1] };
+    } else {
+	return unless $g->has_edge( @_ );
+    }
+    my @i = $g->_vertex_ids( @_ );
+    $E->_get_path_attr( @i, $attr );
+}
+
+sub get_edge_attribute {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $attr = pop;
+    return undef unless $g->has_edge( @_ );
+    my @i = $g->_vertex_ids( @_ );
+    return undef if @i == 0 && @_;
+    my $E = $g->[ _E ];
+    $E->_get_path_attr( @i, $attr );
+}
+
+sub get_edge_attribute_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $attr = pop;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_get_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
+}
+
+sub get_edge_attribute_names {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    return unless $g->has_edge( @_ );
+    $g->[ _E ]->_get_path_attr_names( $g->_vertex_ids( @_ ) );
+}
+
+sub get_edge_attribute_names_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_get_path_attr_names( $g->_vertex_ids( @_ ), $id );
+}
+
+sub get_edge_attribute_values {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    return unless $g->has_edge( @_ );
+    $g->[ _E ]->_get_path_attr_values( $g->_vertex_ids( @_ ) );
+}
+
+sub get_edge_attribute_values_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_get_path_attr_values( $g->_vertex_ids( @_ ), $id );
+}
+
+sub delete_edge_attributes {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    return unless $g->has_edge( @_ );
+    $g->[ _E ]->_del_path_attrs( $g->_vertex_ids( @_ ) );
+}
+
+sub delete_edge_attributes_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_del_path_attrs( $g->_vertex_ids( @_ ), $id );
+}
+
+sub delete_edge_attribute {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $attr = pop;
+    return unless $g->has_edge( @_ );
+    $g->[ _E ]->_del_path_attr( $g->_vertex_ids( @_ ), $attr );
+}
+
+sub delete_edge_attribute_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $attr = pop;
+    return unless $g->has_edge_by_id( @_ );
+    my $id = pop;
+    $g->[ _E ]->_del_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
+}
+
+###
+# Compat.
+#
+
+sub vertex {
+    my $g = shift;
+    $g->has_vertex( @_ ) ? @_ : undef;
+}
+
+sub out_edges {
+    my $g = shift;
+    return unless @_ && $g->has_vertex( @_ );
+    my @e = $g->edges_from( @_ );
+    wantarray ? map { @$_ } @e : @e;
+}
+
+sub in_edges {
+    my $g = shift;
+    return unless @_ && $g->has_vertex( @_ );
+    my @e = $g->edges_to( @_ );
+    wantarray ? map { @$_ } @e : @e;
+}
+
+sub add_vertices {
+    my $g = shift;
+    $g->add_vertex( $_ ) for @_;
+}
+
+sub add_edges {
+    my $g = shift;
+    while (@_) {
+	my $u = shift @_;
+	if (ref $u eq 'ARRAY') {
+	    $g->add_edge( @$u );
+	} else {
+	    if (@_) {
+		my $v = shift @_;
+		$g->add_edge( $u, $v );
+	    } else {
+		require Carp;
+		Carp::croak("Graph::add_edges: missing end vertex");
+	    }
+	}
+    }
+}
+
+###
+# More constructors.
+#
+
+sub copy {
+    my $g = shift;
+    my %opt = _get_options( \@_ );
+    
+    my $c = (ref $g)->new(directed => $g->directed ? 1 : 0,
+			  compat02 => $g->compat02 ? 1 : 0);
+    for my $v ($g->isolated_vertices) { $c->add_vertex($v) }
+    for my $e ($g->edges05)           { $c->add_edge(@$e)  }
+    return $c;
+}
+
+*copy_graph = \©
+
+sub deep_copy {
+    require Data::Dumper;
+    my $g = shift;
+    my $d = Data::Dumper->new([$g]);
+    use vars qw($VAR1);
+    $d->Purity(1)->Terse(1)->Deepcopy(1);
+    $d->Deparse(1) if $] >= 5.008;
+    eval $d->Dump;
+}
+
+*deep_copy_graph = \&deep_copy;
+
+sub transpose_edge {
+    my $g = shift;
+    if ($g->is_directed) {
+	return undef unless $g->has_edge( @_ );
+	my $c = $g->get_edge_count( @_ );
+	my $a = $g->get_edge_attributes( @_ );
+	my @e = reverse @_;
+	$g->delete_edge( @_ ) unless $g->has_edge( @e );
+	$g->add_edge( @e ) for 1..$c;
+	$g->set_edge_attributes(@e, $a) if $a;
+    }
+    return $g;
+}
+
+sub transpose_graph {
+    my $g = shift;
+    my $t = $g->copy;
+    if ($t->directed) {
+	for my $e ($t->edges05) {
+	    $t->transpose_edge(@$e);
+	}
+    }
+    return $t;
+}
+
+*transpose = \&transpose_graph;
+
+sub complete_graph {
+    my $g = shift;
+    my $c = $g->new( directed => $g->directed );
+    my @v = $g->vertices05;
+    for (my $i = 0; $i <= $#v; $i++ ) {
+	for (my $j = 0; $j <= $#v; $j++ ) {
+	    next if $i >= $j;
+	    if ($g->is_undirected) {
+		$c->add_edge($v[$i], $v[$j]);
+	    } else {
+		$c->add_edge($v[$i], $v[$j]);
+		$c->add_edge($v[$j], $v[$i]);
+	    }
+	}
+    }
+    return $c;
+}
+
+*complement = \&complement_graph;
+
+sub complement_graph {
+    my $g = shift;
+    my $c = $g->new( directed => $g->directed );
+    my @v = $g->vertices05;
+    for (my $i = 0; $i <= $#v; $i++ ) {
+	for (my $j = 0; $j <= $#v; $j++ ) {
+	    next if $i >= $j;
+	    if ($g->is_undirected) {
+		$c->add_edge($v[$i], $v[$j])
+		    unless $g->has_edge($v[$i], $v[$j]);
+	    } else {
+		$c->add_edge($v[$i], $v[$j])
+		    unless $g->has_edge($v[$i], $v[$j]);
+		$c->add_edge($v[$j], $v[$i])
+		    unless $g->has_edge($v[$j], $v[$i]);
+	    }
+	}
+    }
+    return $c;
+}
+
+*complete = \&complete_graph;
+
+###
+# Transitivity.
+#
+
+sub is_transitive {
+    my $g = shift;
+    Graph::TransitiveClosure::is_transitive($g);
+}
+
+###
+# Weighted vertices.
+#
+
+my $defattr = 'weight';
+
+sub _defattr {
+    return $defattr;
+}
+
+sub add_weighted_vertex {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $w = pop;
+    $g->add_vertex(@_);
+    $g->set_vertex_attribute(@_, $defattr, $w);
+}
+
+sub add_weighted_vertices {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    while (@_) {
+	my ($v, $w) = splice @_, 0, 2;
+	$g->add_vertex($v);
+	$g->set_vertex_attribute($v, $defattr, $w);
+    }
+}
+
+sub get_vertex_weight {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    $g->get_vertex_attribute(@_, $defattr);
+}
+
+sub has_vertex_weight {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    $g->has_vertex_attribute(@_, $defattr);
+}
+
+sub set_vertex_weight {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    my $w = pop;
+    $g->set_vertex_attribute(@_, $defattr, $w);
+}
+
+sub delete_vertex_weight {
+    my $g = shift;
+    $g->expect_non_multivertexed;
+    $g->delete_vertex_attribute(@_, $defattr);
+}
+
+sub add_weighted_vertex_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $w = pop;
+    $g->add_vertex_by_id(@_);
+    $g->set_vertex_attribute_by_id(@_, $defattr, $w);
+}
+
+sub add_weighted_vertices_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $id = pop;
+    while (@_) {
+	my ($v, $w) = splice @_, 0, 2;
+	$g->add_vertex_by_id($v, $id);
+	$g->set_vertex_attribute_by_id($v, $id, $defattr, $w);
+    }
+}
+
+sub get_vertex_weight_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->get_vertex_attribute_by_id(@_, $defattr);
+}
+
+sub has_vertex_weight_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->has_vertex_attribute_by_id(@_, $defattr);
+}
+
+sub set_vertex_weight_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    my $w = pop;
+    $g->set_vertex_attribute_by_id(@_, $defattr, $w);
+}
+
+sub delete_vertex_weight_by_id {
+    my $g = shift;
+    $g->expect_multivertexed;
+    $g->delete_vertex_attribute_by_id(@_, $defattr);
+}
+
+###
+# Weighted edges.
+#
+
+sub add_weighted_edge {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    if ($g->is_compat02) {
+	my $w = splice @_, 1, 1;
+	$g->add_edge(@_);
+	$g->set_edge_attribute(@_, $defattr, $w);
+    } else {
+	my $w = pop;
+	$g->add_edge(@_);
+	$g->set_edge_attribute(@_, $defattr, $w);
+    }
+}
+
+sub add_weighted_edges {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    if ($g->is_compat02) {
+	while (@_) {
+	    my ($u, $w, $v) = splice @_, 0, 3;
+	    $g->add_edge($u, $v);
+	    $g->set_edge_attribute($u, $v, $defattr, $w);
+	}
+    } else {
+	while (@_) {
+	    my ($u, $v, $w) = splice @_, 0, 3;
+	    $g->add_edge($u, $v);
+	    $g->set_edge_attribute($u, $v, $defattr, $w);
+	}
+    }
+}
+
+sub add_weighted_edges_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $id = pop;
+    while (@_) {
+	my ($u, $v, $w) = splice @_, 0, 3;
+	$g->add_edge_by_id($u, $v, $id);
+	$g->set_edge_attribute_by_id($u, $v, $id, $defattr, $w);
+    }
+}
+
+sub add_weighted_path {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $u = shift;
+    while (@_) {
+	my ($w, $v) = splice @_, 0, 2;
+	$g->add_edge($u, $v);
+	$g->set_edge_attribute($u, $v, $defattr, $w);
+	$u = $v;
+    }
+}
+
+sub get_edge_weight {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    $g->get_edge_attribute(@_, $defattr);
+}
+
+sub has_edge_weight {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    $g->has_edge_attribute(@_, $defattr);
+}
+
+sub set_edge_weight {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    my $w = pop;
+    $g->set_edge_attribute(@_, $defattr, $w);
+}
+
+sub delete_edge_weight {
+    my $g = shift;
+    $g->expect_non_multiedged;
+    $g->delete_edge_attribute(@_, $defattr);
+}
+
+sub add_weighted_edge_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    if ($g->is_compat02) {
+	my $w = splice @_, 1, 1;
+	$g->add_edge_by_id(@_);
+	$g->set_edge_attribute_by_id(@_, $defattr, $w);
+    } else {
+	my $w = pop;
+	$g->add_edge_by_id(@_);
+	$g->set_edge_attribute_by_id(@_, $defattr, $w);
+    }
+}
+
+sub add_weighted_path_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $id = pop;
+    my $u = shift;
+    while (@_) {
+	my ($w, $v) = splice @_, 0, 2;
+	$g->add_edge_by_id($u, $v, $id);
+	$g->set_edge_attribute_by_id($u, $v, $id, $defattr, $w);
+	$u = $v;
+    }
+}
+
+sub get_edge_weight_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    $g->get_edge_attribute_by_id(@_, $defattr);
+}
+
+sub has_edge_weight_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    $g->has_edge_attribute_by_id(@_, $defattr);
+}
+
+sub set_edge_weight_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    my $w = pop;
+    $g->set_edge_attribute_by_id(@_, $defattr, $w);
+}
+
+sub delete_edge_weight_by_id {
+    my $g = shift;
+    $g->expect_multiedged;
+    $g->delete_edge_attribute_by_id(@_, $defattr);
+}
+
+###
+# Error helpers.
+#
+
+my %expected;
+@expected{qw(directed undirected acyclic)} = qw(undirected directed cyclic);
+
+sub _expected {
+    my $exp = shift;
+    my $got = @_ ? shift : $expected{$exp};
+    $got = defined $got ? ", got $got" : "";
+    if (my @caller2 = caller(2)) {
+	die "$caller2[3]: expected $exp graph$got, at $caller2[1] line $caller2[2].\n";
+    } else {
+	my @caller1 = caller(1);
+	die "$caller1[3]: expected $exp graph$got, at $caller1[1] line $caller1[2].\n";
+    }
+}
+
+sub expect_undirected {
+    my $g = shift;
+    _expected('undirected') unless $g->is_undirected;
+}
+
+sub expect_directed {
+    my $g = shift;
+    _expected('directed') unless $g->is_directed;
+}
+
+sub expect_acyclic {
+    my $g = shift;
+    _expected('acyclic') unless $g->is_acyclic;
+}
+
+sub expect_dag {
+    my $g = shift;
+    my @got;
+    push @got, 'undirected' unless $g->is_directed;
+    push @got, 'cyclic'     unless $g->is_acyclic;
+    _expected('directed acyclic', "@got") if @got;
+}
+
+sub expect_multivertexed {
+    my $g = shift;
+    _expected('multivertexed') unless $g->is_multivertexed;
+}
+
+sub expect_non_multivertexed {
+    my $g = shift;
+    _expected('non-multivertexed') if $g->is_multivertexed;
+}
+
+sub expect_non_multiedged {
+    my $g = shift;
+    _expected('non-multiedged') if $g->is_multiedged;
+}
+
+sub expect_multiedged {
+    my $g = shift;
+    _expected('multiedged') unless $g->is_multiedged;
+}
+
+sub _get_options {
+    my @caller = caller(1);
+    unless (@_ == 1 && ref $_[0] eq 'ARRAY') {
+	die "$caller[3]: internal error: should be called with only one array ref argument, at $caller[1] line $caller[2].\n";
+    }
+    my @opt = @{ $_[0] };
+    unless (@opt  % 2 == 0) {
+	die "$caller[3]: expected an options hash, got a non-even number of arguments, at $caller[1] line $caller[2].\n";
+    }
+    return @opt;
+}
+
+###
+# Random constructors and accessors.
+#
+
+sub __fisher_yates_shuffle (@) {
+    # From perlfaq4, but modified to be non-modifying.
+    my @a = @_;
+    my $i = @a;
+    while ($i--) {
+	my $j = int rand ($i+1);
+	@a[$i,$j] = @a[$j,$i];
+    }
+    return @a;
+}
+
+BEGIN {
+    sub _shuffle(@);
+    # Workaround for the Perl bug [perl #32383] where -d:Dprof and
+    # List::Util::shuffle do not like each other: if any debugging
+    # (-d) flags are on, fall back to our own Fisher-Yates shuffle.
+    # The bug was fixed by perl changes #26054 and #26062, which
+    # went to Perl 5.9.3.  If someone tests this with a pre-5.9.3
+    # bleadperl that calls itself 5.9.3 but doesn't yet have the
+    # patches, oh, well.
+    *_shuffle = $^P && $] < 5.009003 ?
+	\&__fisher_yates_shuffle : \&List::Util::shuffle;
+}
+
+sub random_graph {
+    my $class = (@_ % 2) == 0 ? 'Graph' : shift;
+    my %opt = _get_options( \@_ );
+    my $random_edge;
+    unless (exists $opt{vertices} && defined $opt{vertices}) {
+	require Carp;
+	Carp::croak("Graph::random_graph: argument 'vertices' missing or undef");
+    }
+    if (exists $opt{random_seed}) {
+	srand($opt{random_seed});
+	delete $opt{random_seed};
+    }
+    if (exists $opt{random_edge}) {
+	$random_edge = $opt{random_edge};
+	delete $opt{random_edge};
+    }
+    my @V;
+    if (my $ref = ref $opt{vertices}) {
+	if ($ref eq 'ARRAY') {
+	    @V = @{ $opt{vertices} };
+	} else {
+	    Carp::croak("Graph::random_graph: argument 'vertices' illegal");
+	}
+    } else {
+	@V = 0..($opt{vertices} - 1);
+    }
+    delete $opt{vertices};
+    my $V = @V;
+    my $C = $V * ($V - 1) / 2;
+    my $E;
+    if (exists $opt{edges} && exists $opt{edges_fill}) {
+	Carp::croak("Graph::random_graph: both arguments 'edges' and 'edges_fill' specified");
+    }
+    $E = exists $opt{edges_fill} ? $opt{edges_fill} * $C : $opt{edges};
+    delete $opt{edges};
+    delete $opt{edges_fill};
+    my $g = $class->new(%opt);
+    $g->add_vertices(@V);
+    return $g if $V < 2;
+    $C *= 2 if $g->directed;
+    $E = $C / 2 unless defined $E;
+    $E = int($E + 0.5);
+    my $p = $E / $C;
+    $random_edge = sub { $p } unless defined $random_edge;
+    # print "V = $V, E = $E, C = $C, p = $p\n";
+    if ($p > 1.0 && !($g->countedged || $g->multiedged)) {
+	require Carp;
+	Carp::croak("Graph::random_graph: needs to be countedged or multiedged ($E > $C)");
+    }
+    my @V1 = @V;
+    my @V2 = @V;
+    # Shuffle the vertex lists so that the pairs at
+    # the beginning of the lists are not more likely.
+    @V1 = _shuffle @V1;
+    @V2 = _shuffle @V2;
+ LOOP:
+    while ($E) {
+	for my $v1 (@V1) {
+	    for my $v2 (@V2) {
+		next if $v1 eq $v2; # TODO: allow self-loops?
+		my $q = $random_edge->($g, $v1, $v2, $p);
+		if ($q && ($q == 1 || rand() <= $q) &&
+		    !$g->has_edge($v1, $v2)) {
+		    $g->add_edge($v1, $v2);
+		    $E--;
+		    last LOOP unless $E;
+		}
+	    }
+	}
+    }
+    return $g;
+}
+
+sub random_vertex {
+    my $g = shift;
+    my @V = $g->vertices05;
+    @V[rand @V];
+}
+
+sub random_edge {
+    my $g = shift;
+    my @E = $g->edges05;
+    @E[rand @E];
+}
+
+sub random_successor {
+    my ($g, $v) = @_;
+    my @S = $g->successors($v);
+    @S[rand @S];
+}
+
+sub random_predecessor {
+    my ($g, $v) = @_;
+    my @P = $g->predecessors($v);
+    @P[rand @P];
+}
+
+###
+# Algorithms.
+#
+
+my $MST_comparator = sub { ($_[0] || 0) <=> ($_[1] || 0) };
+
+sub _MST_attr {
+    my $attr = shift;
+    my $attribute =
+	exists $attr->{attribute}  ?
+	    $attr->{attribute}  : $defattr;
+    my $comparator =
+	exists $attr->{comparator} ?
+	    $attr->{comparator} : $MST_comparator;
+    return ($attribute, $comparator);
+}
+
+sub _MST_edges {
+    my ($g, $attr) = @_;
+    my ($attribute, $comparator) = _MST_attr($attr);
+    map { $_->[1] }
+        sort { $comparator->($a->[0], $b->[0], $a->[1], $b->[1]) }
+             map { [ $g->get_edge_attribute(@$_, $attribute), $_ ] }
+                 $g->edges05;
+}
+
+sub MST_Kruskal {
+    my ($g, %attr) = @_;
+
+    $g->expect_undirected;
+
+    my $MST = Graph::Undirected->new;
+
+    my $UF  = Graph::UnionFind->new;
+    for my $v ($g->vertices05) { $UF->add($v) }
+
+    for my $e ($g->_MST_edges(\%attr)) {
+	my ($u, $v) = @$e; # TODO: hyperedges
+	my $t0 = $UF->find( $u );
+	my $t1 = $UF->find( $v );
+	unless ($t0 eq $t1) {
+	    $UF->union($u, $v);
+	    $MST->add_edge($u, $v);
+	}
+    }
+
+    return $MST;
+}
+
+sub _MST_add {
+    my ($g, $h, $HF, $r, $attr, $unseen) = @_;
+    for my $s ( grep { exists $unseen->{ $_ } } $g->successors( $r ) ) {
+	$HF->add( Graph::MSTHeapElem->new( $r, $s, $g->get_edge_attribute( $r, $s, $attr ) ) );
+    }
+}
+
+sub _next_alphabetic { shift; (sort               keys %{ $_[0] })[0] }
+sub _next_numeric    { shift; (sort { $a <=> $b } keys %{ $_[0] })[0] }
+sub _next_random     { shift; (values %{ $_[0] })[ rand keys %{ $_[0] } ] }
+
+sub _root_opt {
+    my $g = shift;
+    my %opt = @_ == 1 ? ( first_root => $_[0] ) : _get_options( \@_ );
+    my %unseen;
+    my @unseen = $g->vertices05;
+    @unseen{ @unseen } = @unseen;
+    @unseen = _shuffle @unseen;
+    my $r;
+    if (exists $opt{ start }) {
+	$opt{ first_root } = $opt{ start };
+	$opt{ next_root  } = undef;
+    }
+    if (exists $opt{ get_next_root }) {
+	$opt{ next_root  } = $opt{ get_next_root }; # Graph 0.201 compat.
+    }
+    if (exists $opt{ first_root }) {
+	if (ref $opt{ first_root } eq 'CODE') {
+	    $r = $opt{ first_root }->( $g, \%unseen );
+	} else {
+	    $r = $opt{ first_root };
+	}
+    } else {
+	$r = shift @unseen;
+    }
+    my $next =
+	exists $opt{ next_root } ?
+	    $opt{ next_root } :
+		$opt{ next_alphabetic } ?
+		    \&_next_alphabetic :
+			$opt{ next_numeric } ? \&_next_numeric :
+			    \&_next_random;
+    my $code = ref $next eq 'CODE';
+    my $attr = exists $opt{ attribute } ? $opt{ attribute } : $defattr;
+    return ( \%opt, \%unseen, \@unseen, $r, $next, $code, $attr );
+}
+
+sub _heap_walk {
+    my ($g, $h, $add, $etc) = splice @_, 0, 4; # Leave %opt in @_.
+
+    my ($opt, $unseenh, $unseena, $r, $next, $code, $attr) = $g->_root_opt(@_);
+    my $HF = Heap071::Fibonacci->new;
+
+    while (defined $r) {
+	# print "r = $r\n";
+	$add->($g, $h, $HF, $r, $attr, $unseenh, $etc);
+	delete $unseenh->{ $r };
+	while (defined $HF->top) {
+	    my $t = $HF->extract_top;
+	    # use Data::Dumper; print "t = ", Dumper($t);
+	    if (defined $t) {
+		my ($u, $v, $w) = $t->val;
+		# print "extracted top: $u $v $w\n";
+		if (exists $unseenh->{ $v }) {
+		    $h->set_edge_attribute($u, $v, $attr, $w);
+		    delete $unseenh->{ $v };
+		    $add->($g, $h, $HF, $v, $attr, $unseenh, $etc);
+		}
+	    }
+	}
+	return $h unless defined $next;
+	$r = $code ? $next->( $g, $unseenh ) : shift @$unseena;
+    }
+
+    return $h;
+}
+
+sub MST_Prim {
+    my $g = shift;
+    $g->expect_undirected;
+    $g->_heap_walk(Graph::Undirected->new(), \&_MST_add, undef, @_);
+}
+
+*MST_Dijkstra = \&MST_Prim;
+
+*minimum_spanning_tree = \&MST_Prim;
+
+###
+# Cycle detection.
+#
+
+*is_cyclic = \&has_a_cycle;
+
+sub is_acyclic {
+    my $g = shift;
+    return !$g->is_cyclic;
+}
+
+sub is_dag {
+    my $g = shift;
+    return $g->is_directed && $g->is_acyclic ? 1 : 0;
+}
+
+*is_directed_acyclic_graph = \&is_dag;
+
+###
+# Backward compat.
+#
+
+sub average_degree {
+    my $g = shift;
+    my $V = $g->vertices05;
+
+    return $V ? $g->degree / $V : 0;
+}
+
+sub density_limits {
+    my $g = shift;
+
+    my $V = $g->vertices05;
+    my $M = $V * ($V - 1);
+
+    $M /= 2 if $g->is_undirected;
+
+    return ( 0.25 * $M, 0.75 * $M, $M );
+}
+
+sub density {
+    my $g = shift;
+    my ($sparse, $dense, $complete) = $g->density_limits;
+
+    return $complete ? $g->edges / $complete : 0;
+}
+
+###
+# Attribute backward compat
+#
+
+sub _attr02_012 {
+    my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
+    if ($g->is_compat02) {
+	if    (@_ == 0) { return $ga->( $g ) }
+	elsif (@_ == 1) { return $va->( $g, @_ ) }
+	elsif (@_ == 2) { return $ea->( $g, @_ ) }
+	else {
+	    die sprintf "$op: wrong number of arguments (%d)", scalar @_;
+	}
+    } else {
+	die "$op: not a compat02 graph"
+    }
+}
+
+sub _attr02_123 {
+    my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
+    if ($g->is_compat02) {
+	if    (@_ == 1) { return $ga->( $g, @_ ) }
+	elsif (@_ == 2) { return $va->( $g, @_[1, 0] ) }
+	elsif (@_ == 3) { return $ea->( $g, @_[1, 2, 0] ) }
+	else {
+	    die sprintf "$op: wrong number of arguments (%d)", scalar @_;
+	}
+    } else {
+	die "$op: not a compat02 graph"
+    }
+}
+
+sub _attr02_234 {
+    my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
+    if ($g->is_compat02) {
+	if    (@_ == 2) { return $ga->( $g, @_ ) }
+	elsif (@_ == 3) { return $va->( $g, @_[1, 0, 2] ) }
+	elsif (@_ == 4) { return $ea->( $g, @_[1, 2, 0, 3] ) }
+	else {
+	    die sprintf "$op: wrong number of arguments (%d)", scalar @_;
+	}
+    } else {
+	die "$op: not a compat02 graph";
+    }
+}
+
+sub set_attribute {
+    my $g = shift;
+    $g->_attr02_234('set_attribute',
+		    \&Graph::set_graph_attribute,
+		    \&Graph::set_vertex_attribute,
+		    \&Graph::set_edge_attribute,
+		    @_);
+
+}
+
+sub set_attributes {
+    my $g = shift;
+    my $a = pop;
+    $g->_attr02_123('set_attributes',
+		    \&Graph::set_graph_attributes,
+		    \&Graph::set_vertex_attributes,
+		    \&Graph::set_edge_attributes,
+		    $a, @_);
+
+}
+
+sub get_attribute {
+    my $g = shift;
+    $g->_attr02_123('get_attribute',
+		    \&Graph::get_graph_attribute,
+		    \&Graph::get_vertex_attribute,
+		    \&Graph::get_edge_attribute,
+		    @_);
+
+}
+
+sub get_attributes {
+    my $g = shift;
+    $g->_attr02_012('get_attributes',
+		    \&Graph::get_graph_attributes,
+		    \&Graph::get_vertex_attributes,
+		    \&Graph::get_edge_attributes,
+		    @_);
+
+}
+
+sub has_attribute {
+    my $g = shift;
+    return 0 unless @_;
+    $g->_attr02_123('has_attribute',
+		    \&Graph::has_graph_attribute,
+		    \&Graph::has_vertex_attribute,
+		    \&Graph::get_edge_attribute,
+		    @_);
+
+}
+
+sub has_attributes {
+    my $g = shift;
+    $g->_attr02_012('has_attributes',
+		    \&Graph::has_graph_attributes,
+		    \&Graph::has_vertex_attributes,
+		    \&Graph::has_edge_attributes,
+		    @_);
+
+}
+
+sub delete_attribute {
+    my $g = shift;
+    $g->_attr02_123('delete_attribute',
+		    \&Graph::delete_graph_attribute,
+		    \&Graph::delete_vertex_attribute,
+		    \&Graph::delete_edge_attribute,
+		    @_);
+
+}
+
+sub delete_attributes {
+    my $g = shift;
+    $g->_attr02_012('delete_attributes',
+		    \&Graph::delete_graph_attributes,
+		    \&Graph::delete_vertex_attributes,
+		    \&Graph::delete_edge_attributes,
+		    @_);
+
+}
+
+###
+# Simple DFS uses.
+#
+
+sub topological_sort {
+    my $g = shift;
+    my %opt = _get_options( \@_ );
+    my $eic = $opt{ empty_if_cyclic };
+    my $hac;
+    if ($eic) {
+	$hac = $g->has_a_cycle;
+    } else {
+	$g->expect_dag;
+    }
+    delete $opt{ empty_if_cyclic };
+    my $t = Graph::Traversal::DFS->new($g, %opt);
+    my @s = $t->dfs;
+    $hac ? () : reverse @s;
+}
+
+*toposort = \&topological_sort;
+
+sub undirected_copy {
+    my $g = shift;
+
+    $g->expect_directed;
+
+    my $c = Graph::Undirected->new;
+    for my $v ($g->isolated_vertices) { # TODO: if iv ...
+	$c->add_vertex($v);
+    }
+    for my $e ($g->edges05) {
+	$c->add_edge(@$e);
+    }
+    return $c;
+}
+
+*undirected_copy_graph = \&undirected_copy;
+
+sub directed_copy {
+    my $g = shift;
+    $g->expect_undirected;
+    my $c = Graph::Directed->new;
+    for my $v ($g->isolated_vertices) { # TODO: if iv ...
+	$c->add_vertex($v);
+    }
+    for my $e ($g->edges05) {
+	my @e = @$e;
+	$c->add_edge(@e);
+	$c->add_edge(reverse @e);
+    }
+    return $c;
+}
+
+*directed_copy_graph = \&directed_copy;
+
+###
+# Cache or not.
+#
+
+my %_cache_type =
+    (
+     'connectivity'        => '_ccc',
+     'strong_connectivity' => '_scc',
+     'biconnectivity'      => '_bcc',
+     'SPT_Dijkstra'        => '_spt_di',
+     'SPT_Bellman_Ford'    => '_spt_bf',
+    );
+
+sub _check_cache {
+    my ($g, $type, $code) = splice @_, 0, 3;
+    my $c = $_cache_type{$type};
+    if (defined $c) {
+	my $a = $g->get_graph_attribute($c);
+	unless (defined $a && $a->[ 0 ] == $g->[ _G ]) {
+	    $a->[ 0 ] = $g->[ _G ];
+	    $a->[ 1 ] = $code->( $g, @_ );
+	    $g->set_graph_attribute($c, $a);
+	}
+	return $a->[ 1 ];
+    } else {
+	Carp::croak("Graph: unknown cache type '$type'");
+    }
+}
+
+sub _clear_cache {
+    my ($g, $type) = @_;
+    my $c = $_cache_type{$type};
+    if (defined $c) {
+	$g->delete_graph_attribute($c);
+    } else {
+	Carp::croak("Graph: unknown cache type '$type'");
+    }
+}
+
+sub connectivity_clear_cache {
+    my $g = shift;
+    _clear_cache($g, 'connectivity');
+}
+
+sub strong_connectivity_clear_cache {
+    my $g = shift;
+    _clear_cache($g, 'strong_connectivity');
+}
+
+sub biconnectivity_clear_cache {
+    my $g = shift;
+    _clear_cache($g, 'biconnectivity');
+}
+
+sub SPT_Dijkstra_clear_cache {
+    my $g = shift;
+    _clear_cache($g, 'SPT_Dijkstra');
+    $g->delete_graph_attribute('SPT_Dijkstra_first_root');
+}
+
+sub SPT_Bellman_Ford_clear_cache {
+    my $g = shift;
+    _clear_cache($g, 'SPT_Bellman_Ford');
+}
+
+###
+# Connected components.
+#
+
+sub _connected_components_compute {
+    my $g = shift;
+    my %cce;
+    my %cci;
+    my $cc = 0;
+    if ($g->has_union_find) {
+	my $UF = $g->_get_union_find();
+	my $V  = $g->[ _V ];
+	my %icce; # Isolated vertices.
+	my %icci;
+	my $icc = 0;
+	for my $v ( $g->unique_vertices ) {
+	    $cc = $UF->find( $V->_get_path_id( $v ) );
+	    if (defined $cc) {
+		$cce{ $v } = $cc;
+		push @{ $cci{ $cc } }, $v;
+	    } else {
+		$icce{ $v } = $icc;
+		push @{ $icci{ $icc } }, $v;
+		$icc++;
+	    }
+	}
+	if ($icc) {
+	    @cce{ keys %icce } = values %icce;
+	    @cci{ keys %icci } = values %icci;
+	}
+    } else {
+	my @u = $g->unique_vertices;
+	my %r; @r{ @u } = @u;
+	my $froot = sub {
+	    (each %r)[1];
+	};
+	my $nroot = sub {
+	    $cc++ if keys %r;
+	    (each %r)[1];
+	};
+	my $t = Graph::Traversal::DFS->new($g,
+					   first_root => $froot,
+					   next_root  => $nroot,
+					   pre => sub {
+					       my ($v, $t) = @_;
+					       $cce{ $v } = $cc;
+					       push @{ $cci{ $cc } }, $v;
+					       delete $r{ $v };
+					   },
+					   @_);
+	$t->dfs;
+    }
+    return [ \%cce, \%cci ];
+}
+
+sub _connected_components {
+    my $g = shift;
+    my $ccc = _check_cache($g, 'connectivity',
+			   \&_connected_components_compute, @_);
+    return @{ $ccc };
+}
+
+sub connected_component_by_vertex {
+    my ($g, $v) = @_;
+    $g->expect_undirected;
+    my ($CCE, $CCI) = $g->_connected_components();
+    return $CCE->{ $v };
+}
+
+sub connected_component_by_index {
+    my ($g, $i) = @_;
+    $g->expect_undirected;
+    my ($CCE, $CCI) = $g->_connected_components();
+    return defined $CCI->{ $i } ? @{ $CCI->{ $i } } : ( );
+}
+
+sub connected_components {
+    my $g = shift;
+    $g->expect_undirected;
+    my ($CCE, $CCI) = $g->_connected_components();
+    return values %{ $CCI };
+}
+
+sub same_connected_components {
+    my $g = shift;
+    $g->expect_undirected;
+    if ($g->has_union_find) {
+	my $UF = $g->_get_union_find();
+	my $V  = $g->[ _V ];
+	my $u = shift;
+	my $c = $UF->find( $V->_get_path_id ( $u ) );
+	my $d;
+	for my $v ( @_) {
+	    return 0
+		unless defined($d = $UF->find( $V->_get_path_id( $v ) )) &&
+		       $d eq $c;
+	}
+	return 1;
+    } else {
+	my ($CCE, $CCI) = $g->_connected_components();
+	my $u = shift;
+	my $c = $CCE->{ $u };
+	for my $v ( @_) {
+	    return 0
+		unless defined $CCE->{ $v } &&
+		       $CCE->{ $v } eq $c;
+	}
+	return 1;
+    }
+}
+
+my $super_component = sub { join("+", sort @_) };
+
+sub connected_graph {
+    my ($g, %opt) = @_;
+    $g->expect_undirected;
+    my $cg = Graph->new(undirected => 1);
+    if ($g->has_union_find && $g->vertices == 1) {
+	# TODO: super_component?
+	$cg->add_vertices($g->vertices);
+    } else {
+	my $sc_cb =
+	    exists $opt{super_component} ?
+		$opt{super_component} : $super_component;
+	for my $cc ( $g->connected_components() ) {
+	    my $sc = $sc_cb->(@$cc);
+	    $cg->add_vertex($sc);
+	    $cg->set_vertex_attribute($sc, 'subvertices', [ @$cc ]);
+	}
+    }
+    return $cg;
+}
+
+sub is_connected {
+    my $g = shift;
+    $g->expect_undirected;
+    my ($CCE, $CCI) = $g->_connected_components();
+    return keys %{ $CCI } == 1;
+}
+
+sub is_weakly_connected {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->is_connected(@_);
+}
+
+*weakly_connected = \&is_weakly_connected;
+
+sub weakly_connected_components {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->connected_components(@_);
+}
+
+sub weakly_connected_component_by_vertex {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->connected_component_by_vertex(@_);
+}
+
+sub weakly_connected_component_by_index {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->connected_component_by_index(@_);
+}
+
+sub same_weakly_connected_components {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->same_connected_components(@_);
+}
+
+sub weakly_connected_graph {
+    my $g = shift;
+    $g->expect_directed;
+    $g->undirected_copy->connected_graph(@_);
+}
+
+sub _strongly_connected_components_compute {
+    my $g = shift;
+    my $t = Graph::Traversal::DFS->new($g);
+    my @d = reverse $t->dfs;
+    my @c;
+    my $h = $g->transpose_graph;
+    my $u =
+	Graph::Traversal::DFS->new($h,
+				   next_root => sub {
+				       my ($t, $u) = @_;
+				       my $root;
+				       while (defined($root = shift @d)) {
+					   last if exists $u->{ $root };
+				       }
+				       if (defined $root) {
+					   push @c, [];
+					   return $root;
+				       } else {
+					   return;
+				       }
+				   },
+				   pre => sub {
+				       my ($v, $t) = @_;
+				       push @{ $c[-1] }, $v;
+				   },
+				   @_);
+    $u->dfs;
+    return \@c;
+}
+
+sub _strongly_connected_components {
+    my $g = shift;
+    my $scc = _check_cache($g, 'strong_connectivity',
+			   \&_strongly_connected_components_compute, @_);
+    return defined $scc ? @$scc : ( );
+}
+
+sub strongly_connected_components {
+    my $g = shift;
+    $g->expect_directed;
+    $g->_strongly_connected_components(@_);
+}
+
+sub strongly_connected_component_by_vertex {
+    my $g = shift;
+    my $v = shift;
+    $g->expect_directed;
+    my @scc = $g->_strongly_connected_components( next_alphabetic => 1, @_ );
+    for (my $i = 0; $i <= $#scc; $i++) {
+	for (my $j = 0; $j <= $#{ $scc[$i] }; $j++) {
+	    return $i if $scc[$i]->[$j] eq $v;
+	}
+    }
+    return;
+}
+
+sub strongly_connected_component_by_index {
+    my $g = shift;
+    my $i = shift;
+    $g->expect_directed;
+    my $c = ( $g->_strongly_connected_components(@_) )[ $i ];
+    return defined $c ? @{ $c } : ();
+}
+
+sub same_strongly_connected_components {
+    my $g = shift;
+    $g->expect_directed;
+    my @scc = $g->_strongly_connected_components( next_alphabetic => 1, @_ );
+    my @i;
+    while (@_) {
+	my $v = shift;
+	for (my $i = 0; $i <= $#scc; $i++) {
+	    for (my $j = 0; $j <= $#{ $scc[$i] }; $j++) {
+		if ($scc[$i]->[$j] eq $v) {
+		    push @i, $i;
+		    return 0 if @i > 1 && $i[-1] ne $i[0];
+		}
+	    }
+	}
+    }
+    return 1;
+}
+
+sub is_strongly_connected {
+    my $g = shift;
+    $g->expect_directed;
+    my $t = Graph::Traversal::DFS->new($g);
+    my @d = reverse $t->dfs;
+    my @c;
+    my $h = $g->transpose;
+    my $u =
+	Graph::Traversal::DFS->new($h,
+				   next_root => sub {
+				       my ($t, $u) = @_;
+				       my $root;
+				       while (defined($root = shift @d)) {
+					   last if exists $u->{ $root };
+				       }
+				       if (defined $root) {
+					   unless (@{ $t->{ roots } }) {
+					       push @c, [];
+					       return $root;
+					   } else {
+					       $t->terminate;
+					       return;
+					   }
+				       } else {
+					   return;
+				       }
+				   },
+				   pre => sub {
+				       my ($v, $t) = @_;
+				       push @{ $c[-1] }, $v;
+				   },
+				   @_);
+    $u->dfs;
+    return @{ $u->{ roots } } == 1 && keys %{ $u->{ unseen } } == 0;
+}
+
+*strongly_connected = \&is_strongly_connected;
+
+sub strongly_connected_graph {
+    my $g = shift;
+    my %attr = @_;
+
+    $g->expect_directed;
+
+    my $t = Graph::Traversal::DFS->new($g);
+    my @d = reverse $t->dfs;
+    my @c;
+    my $h = $g->transpose;
+    my $u =
+	Graph::Traversal::DFS->new($h,
+				   next_root => sub {
+				       my ($t, $u) = @_;
+				       my $root;
+				       while (defined($root = shift @d)) {
+					   last if exists $u->{ $root };
+				       }
+				       if (defined $root) {
+					   push @c, [];
+					   return $root;
+				       } else {
+					   return;
+				       }
+				   },
+				   pre => sub {
+				       my ($v, $t) = @_;
+				       push @{ $c[-1] }, $v;
+				   }
+				   );
+
+    $u->dfs;
+
+    my $sc_cb;
+    my $hv_cb;
+
+    _opt_get(\%attr, super_component => \$sc_cb);
+    _opt_get(\%attr, hypervertex => \$hv_cb);
+    _opt_unknown(\%attr);
+
+    if (defined $hv_cb && !defined $sc_cb) {
+	$sc_cb = sub { $hv_cb->( [ @_ ] ) };
+    }
+    unless (defined $sc_cb) {
+	$sc_cb = $super_component;
+    }
+
+    my $s = Graph->new;
+
+    my %c;
+    my @s;
+    for (my $i = 0; $i <  @c; $i++) {
+	my $c = $c[$i];
+	$s->add_vertex( $s[$i] = $sc_cb->(@$c) );
+	$s->set_vertex_attribute($s[$i], 'subvertices', [ @$c ]);
+	for my $v (@$c) {
+	    $c{$v} = $i;
+	}
+    }
+
+    my $n = @c;
+    for my $v ($g->vertices) {
+	unless (exists $c{$v}) {
+	    $c{$v} = $n;
+	    $s[$n] = $v;
+	    $n++;
+	}
+    }
+
+    for my $e ($g->edges05) {
+	my ($u, $v) = @$e; # @TODO: hyperedges
+	unless ($c{$u} == $c{$v}) {
+	    my ($p, $q) = ( $s[ $c{ $u } ], $s[ $c{ $v } ] );
+	    $s->add_edge($p, $q) unless $s->has_edge($p, $q);
+	}
+    }
+
+    if (my @i = $g->isolated_vertices) {
+	$s->add_vertices(map { $s[ $c{ $_ } ] } @i);
+    }
+
+    return $s;
+}
+
+###
+# Biconnectivity.
+#
+
+sub _make_bcc {
+    my ($S, $v, $c) = @_;
+    my %b;
+    while (@$S) {
+	my $t = pop @$S;
+	$b{ $t } = $t;
+	last if $t eq $v;
+    }
+    return [ values %b, $c ];
+}
+
+sub _biconnectivity_compute {
+    my $g = shift;
+    my ($opt, $unseenh, $unseena, $r, $next, $code, $attr) =
+	$g->_root_opt(@_);
+    return () unless defined $r;
+    my %P;
+    my %I;
+    for my $v ($g->vertices) {
+	$I{ $v } = 0;
+    }
+    $I{ $r } = 1;
+    my %U;
+    my %S; # Self-loops.
+    for my $e ($g->edges) {
+	my ($u, $v) = @$e;
+	$U{ $u }{ $v } = 0;
+	$U{ $v }{ $u } = 0;
+	$S{ $u } = 1 if $u eq $v;
+    }
+    my $i = 1;
+    my $v = $r;
+    my %AP;
+    my %L = ( $r => 1 );
+    my @S = ( $r );
+    my %A;
+    my @V = $g->vertices;
+
+    # print "V : @V\n";
+    # print "r : $r\n";
+
+    my %T; @T{ @V } = @V;
+
+    for my $w (@V) {
+	my @s = $g->successors( $w );
+	if (@s) {
+	    @s = grep { $_ eq $w ? ( delete $T{ $w }, 0 ) : 1 } @s;
+	    @{ $A{ $w } }{ @s } = @s;
+	} elsif ($g->predecessors( $w ) == 0) {
+	    delete $T{ $w };
+	    if ($w eq $r) {
+		delete $I { $r };
+		$r = $v = each %T;
+		if (defined $r) {
+		    %L = ( $r => 1 );
+		    @S = ( $r );
+		    $I{ $r } = 1;
+		    # print "r : $r\n";
+		}
+	    }
+	}
+    }
+
+    # use Data::Dumper;
+    # print "T : ", Dumper(\%T);
+    # print "A : ", Dumper(\%A);
+
+    my %V2BC;
+    my @BR;
+    my @BC;
+
+    my @C;
+    my $Avok;
+
+    while (keys %T) {
+	# print "T = ", Dumper(\%T);
+	do {
+	    my $w;
+	    do {
+		my @w = _shuffle values %{ $A{ $v } };
+		# print "w = @w\n";
+		$w = first { !$U{ $v }{ $_ } } @w;
+		if (defined $w) {
+		    # print "w = $w\n";
+		    $U{ $v }{ $w }++;
+		    $U{ $w }{ $v }++;
+		    if ($I{ $w } == 0) {
+			$P{ $w } = $v;
+			$i++;
+			$I{ $w } = $i;
+			$L{ $w } = $i;
+			push @S, $w;
+			$v = $w;
+		    } else {
+			$L{ $v } = $I{ $w } if $I{ $w } < $L{ $v };
+		    }
+		}
+	    } while (defined $w);
+	    # print "U = ", Dumper(\%U);
+	    # print "P = ", Dumper(\%P);
+	    # print "L = ", Dumper(\%L);
+	    if (!defined $P{ $v }) {
+		# Do nothing.
+	    } elsif ($P{ $v } ne $r) {
+		if ($L{ $v } < $I{ $P{ $v } }) {
+		    $L{ $P{ $v } } = $L{ $v } if $L{ $v } < $L{ $P{ $v } };
+		} else {
+		    $AP{ $P{ $v } } = $P{ $v };
+		    push @C, _make_bcc(\@S, $v, $P{ $v } );
+		}
+	    } else {
+		my $e;
+		for my $w (_shuffle keys %{ $A{ $r } }) {
+		    # print "w = $w\n";
+		    unless ($U{ $r }{ $w }) {
+			$e = $r;
+			# print "e = $e\n";
+			last;
+		    }
+		}
+		$AP{ $e } = $e if defined $e;
+		push @C, _make_bcc(\@S, $v, $r);
+	    }
+	    # print "AP = ", Dumper(\%AP);
+	    # print "C  = ", Dumper(\@C);
+	    # print "L  = ", Dumper(\%L);
+	    $v = defined $P{ $v } ? $P{ $v } : $r;
+	    # print "v = $v\n";
+	    $Avok = 0;
+	    if (defined $v) {
+		if (keys %{ $A{ $v } }) {
+		    if (!exists $P{ $v }) {
+			for my $w (keys %{ $A{ $v } }) {
+			    $Avok++ if $U{ $v }{ $w };
+			}
+			# print "Avok/1 = $Avok\n";
+			$Avok = 0 unless $Avok == keys %{ $A{ $v } };
+			# print "Avok/2 = $Avok\n";
+		    }
+		} else {
+		    $Avok = 1;
+		    # print "Avok/3 = $Avok\n";
+		}
+	    }
+	} until ($Avok);
+
+	last if @C == 0 && !exists $S{$v};
+
+	for (my $i = 0; $i < @C; $i++) {
+	    for my $v (@{ $C[ $i ]}) {
+		$V2BC{ $v }{ $i }++;
+		delete $T{ $v };
+	    }
+	}
+
+	for (my $i = 0; $i < @C; $i++) {
+	    if (@{ $C[ $i ] } == 2) {
+		push @BR, $C[ $i ];
+	    } else {
+		push @BC, $C[ $i ];
+	    }
+	}
+
+	if (keys %T) {
+	    $r = $v = each %T;
+	}
+    }
+    
+    return [ [values %AP], \@BC, \@BR, \%V2BC ];
+}
+
+sub biconnectivity {
+    my $g = shift;
+    $g->expect_undirected;
+    my $bcc = _check_cache($g, 'biconnectivity',
+			   \&_biconnectivity_compute, @_);
+    return defined $bcc ? @$bcc : ( );
+}
+
+sub is_biconnected {
+    my $g = shift;
+    my ($ap, $bc) = ($g->biconnectivity(@_))[0, 1];
+    return defined $ap ? @$ap == 0 && $g->vertices >= 3 : undef;
+}
+
+sub is_edge_connected {
+    my $g = shift;
+    my ($br) = ($g->biconnectivity(@_))[2];
+    return defined $br ? @$br == 0 && $g->edges : undef;
+}
+
+sub is_edge_separable {
+    my $g = shift;
+    my $c = $g->is_edge_connected;
+    defined $c ? !$c && $g->edges : undef;
+}
+
+sub articulation_points {
+    my $g = shift;
+    my ($ap) = ($g->biconnectivity(@_))[0];
+    return defined $ap ? @$ap : ();
+}
+
+*cut_vertices = \&articulation_points;
+
+sub biconnected_components {
+    my $g = shift;
+    my ($bc) = ($g->biconnectivity(@_))[1];
+    return defined $bc ? @$bc : ();
+}
+
+sub biconnected_component_by_index {
+    my $g = shift;
+    my $i = shift;
+    my ($bc) = ($g->biconnectivity(@_))[1];
+    return defined $bc ? $bc->[ $i ] : undef;
+}
+
+sub biconnected_component_by_vertex {
+    my $g = shift;
+    my $v = shift;
+    my ($v2bc) = ($g->biconnectivity(@_))[3];
+    return defined $v2bc->{ $v } ? keys %{ $v2bc->{ $v } } : ();
+}
+
+sub same_biconnected_components {
+    my $g = shift;
+    my $u = shift;
+    my @u = $g->biconnected_component_by_vertex($u, @_);
+    return 0 unless @u;
+    my %ubc; @ubc{ @u } = ();
+    while (@_) {
+	my $v = shift;
+	my @v = $g->biconnected_component_by_vertex($v);
+	if (@v) {
+	    my %vbc; @vbc{ @v } = ();
+	    my $vi;
+	    for my $ui (keys %ubc) {
+		if (exists $vbc{ $ui }) {
+		    $vi = $ui;
+		    last;
+		}
+	    }
+	    return 0 unless defined $vi;
+	}
+    }
+    return 1;
+}
+
+sub biconnected_graph {
+    my ($g, %opt) = @_;
+    my ($bc, $v2bc) = ($g->biconnectivity, %opt)[1, 3];
+    my $bcg = Graph::Undirected->new;
+    my $sc_cb =
+	exists $opt{super_component} ?
+	    $opt{super_component} : $super_component;
+    for my $c (@$bc) {
+	$bcg->add_vertex(my $s = $sc_cb->(@$c));
+	$bcg->set_vertex_attribute($s, 'subvertices', [ @$c ]);
+    }
+    my %k;
+    for my $i (0..$#$bc) {
+	my @u = @{ $bc->[ $i ] };
+	my %i; @i{ @u } = ();
+	for my $j (0..$#$bc) {
+	    if ($i > $j) {
+		my @v = @{ $bc->[ $j ] };
+		my %j; @j{ @v } = ();
+		for my $u (@u) {
+		    if (exists $j{ $u }) {
+			unless ($k{ $i }{ $j }++) {
+			    $bcg->add_edge($sc_cb->(@{$bc->[$i]}),
+					   $sc_cb->(@{$bc->[$j]}));
+			}
+			last;
+		    }
+		}
+	    }
+	}
+    }
+    return $bcg;
+}
+
+sub bridges {
+    my $g = shift;
+    my ($br) = ($g->biconnectivity(@_))[2];
+    return defined $br ? @$br : ();
+}
+
+###
+# SPT.
+#
+
+sub _SPT_add {
+    my ($g, $h, $HF, $r, $attr, $unseen, $etc) = @_;
+    my $etc_r = $etc->{ $r } || 0;
+    for my $s ( grep { exists $unseen->{ $_ } } $g->successors( $r ) ) {
+	my $t = $g->get_edge_attribute( $r, $s, $attr );
+	$t = 1 unless defined $t;
+	if ($t < 0) {
+	    require Carp;
+	    Carp::croak("Graph::SPT_Dijkstra: edge $r-$s is negative ($t)");
+	}
+	if (!defined($etc->{ $s }) || ($etc_r + $t) < $etc->{ $s }) {
+	    my $etc_s = $etc->{ $s } || 0;
+	    $etc->{ $s } = $etc_r + $t;
+	    # print "$r - $s : setting $s to $etc->{ $s } ($etc_r, $etc_s)\n";
+	    $h->set_vertex_attribute( $s, $attr, $etc->{ $s });
+	    $h->set_vertex_attribute( $s, 'p', $r );
+	    $HF->add( Graph::SPTHeapElem->new($r, $s, $etc->{ $s }) );
+	}
+    }
+}
+
+sub _SPT_Dijkstra_compute {
+}
+
+sub SPT_Dijkstra {
+    my $g = shift;
+    my %opt = @_ == 1 ? (first_root => $_[0]) : @_;
+    my $first_root = $opt{ first_root };
+    unless (defined $first_root) {
+	$opt{ first_root } = $first_root = $g->random_vertex();
+    }
+    my $spt_di = $g->get_graph_attribute('_spt_di');
+    unless (defined $spt_di && exists $spt_di->{ $first_root } && $spt_di->{ $first_root }->[ 0 ] == $g->[ _G ]) {
+	my %etc;
+	my $sptg = $g->_heap_walk($g->new, \&_SPT_add, \%etc, %opt);
+	$spt_di->{ $first_root } = [ $g->[ _G ], $sptg ];
+	$g->set_graph_attribute('_spt_di', $spt_di);
+    }
+
+    my $spt = $spt_di->{ $first_root }->[ 1 ];
+
+    $spt->set_graph_attribute('SPT_Dijkstra_root', $first_root);
+
+    return $spt;
+}
+
+*SSSP_Dijkstra = \&SPT_Dijkstra;
+
+*single_source_shortest_paths = \&SPT_Dijkstra;
+
+sub SP_Dijkstra {
+    my ($g, $u, $v) = @_;
+    my $sptg = $g->SPT_Dijkstra(first_root => $u);
+    my @path = ($v);
+    my %seen;
+    my $V = $g->vertices;
+    my $p;
+    while (defined($p = $sptg->get_vertex_attribute($v, 'p'))) {
+	last if exists $seen{$p};
+	push @path, $p;
+	$v = $p;
+	$seen{$p}++;
+	last if keys %seen == $V || $u eq $v;
+    }
+    @path = () if @path && $path[-1] ne $u;
+    return reverse @path;
+}
+
+sub __SPT_Bellman_Ford {
+    my ($g, $u, $v, $attr, $d, $p, $c0, $c1) = @_;
+    return unless $c0->{ $u };
+    my $w = $g->get_edge_attribute($u, $v, $attr);
+    $w = 1 unless defined $w;
+    if (defined $d->{ $v }) {
+	if (defined $d->{ $u }) {
+	    if ($d->{ $v } > $d->{ $u } + $w) {
+		$d->{ $v } = $d->{ $u } + $w;
+		$p->{ $v } = $u;
+		$c1->{ $v }++;
+	    }
+	} # else !defined $d->{ $u } &&  defined $d->{ $v }
+    } else {
+	if (defined $d->{ $u }) {
+	    #  defined $d->{ $u } && !defined $d->{ $v }
+	    $d->{ $v } = $d->{ $u } + $w;
+	    $p->{ $v } = $u;
+	    $c1->{ $v }++;
+	} # else !defined $d->{ $u } && !defined $d->{ $v }
+    }
+}
+
+sub _SPT_Bellman_Ford {
+    my ($g, $opt, $unseenh, $unseena, $r, $next, $code, $attr) = @_;
+    my %d;
+    return unless defined $r;
+    $d{ $r } = 0;
+    my %p;
+    my $V = $g->vertices;
+    my %c0; # Changed during the last iteration?
+    $c0{ $r }++;
+    for (my $i = 0; $i < $V; $i++) {
+	my %c1;
+	for my $e ($g->edges) {
+	    my ($u, $v) = @$e;
+	    __SPT_Bellman_Ford($g, $u, $v, $attr, \%d, \%p, \%c0, \%c1);
+	    if ($g->undirected) {
+		__SPT_Bellman_Ford($g, $v, $u, $attr, \%d, \%p, \%c0, \%c1);
+	    }
+	}
+	%c0 = %c1 unless $i == $V - 1;
+    }
+
+    for my $e ($g->edges) {
+	my ($u, $v) = @$e;
+	if (defined $d{ $u } && defined $d{ $v }) {
+	    my $d = $g->get_edge_attribute($u, $v, $attr);
+	    if (defined $d && $d{ $v } > $d{ $u } + $d) {
+		require Carp;
+		Carp::croak("Graph::SPT_Bellman_Ford: negative cycle exists");
+	    }
+	}
+    }
+
+    return (\%p, \%d);
+}
+
+sub _SPT_Bellman_Ford_compute {
+}
+
+sub SPT_Bellman_Ford {
+    my $g = shift;
+
+    my ($opt, $unseenh, $unseena, $r, $next, $code, $attr) = $g->_root_opt(@_);
+
+    unless (defined $r) {
+	$r = $g->random_vertex();
+	return unless defined $r;
+    }
+
+    my $spt_bf = $g->get_graph_attribute('_spt_bf');
+    unless (defined $spt_bf &&
+	    exists $spt_bf->{ $r } && $spt_bf->{ $r }->[ 0 ] == $g->[ _G ]) {
+	my ($p, $d) =
+	    $g->_SPT_Bellman_Ford($opt, $unseenh, $unseena,
+				  $r, $next, $code, $attr);
+	my $h = $g->new;
+	for my $v (keys %$p) {
+	    my $u = $p->{ $v };
+	    $h->add_edge( $u, $v );
+	    $h->set_edge_attribute( $u, $v, $attr,
+				    $g->get_edge_attribute($u, $v, $attr));
+	    $h->set_vertex_attribute( $v, $attr, $d->{ $v } );
+	    $h->set_vertex_attribute( $v, 'p', $u );
+	}
+	$spt_bf->{ $r } = [ $g->[ _G ], $h ];
+	$g->set_graph_attribute('_spt_bf', $spt_bf);
+    }
+
+    my $spt = $spt_bf->{ $r }->[ 1 ];
+
+    $spt->set_graph_attribute('SPT_Bellman_Ford_root', $r);
+
+    return $spt;
+}
+
+*SSSP_Bellman_Ford = \&SPT_Bellman_Ford;
+
+sub SP_Bellman_Ford {
+    my ($g, $u, $v) = @_;
+    my $sptg = $g->SPT_Bellman_Ford(first_root => $u);
+    my @path = ($v);
+    my %seen;
+    my $V = $g->vertices;
+    my $p;
+    while (defined($p = $sptg->get_vertex_attribute($v, 'p'))) {
+	last if exists $seen{$p};
+	push @path, $p;
+	$v = $p;
+	$seen{$p}++;
+	last if keys %seen == $V;
+    }
+    # @path = () if @path && "$path[-1]" ne "$u";
+    return reverse @path;
+}
+
+###
+# Transitive Closure.
+#
+
+sub TransitiveClosure_Floyd_Warshall {
+    my $self = shift;
+    my $class = ref $self || $self;
+    $self = shift unless ref $self;
+    bless Graph::TransitiveClosure->new($self, @_), $class;
+}
+
+*transitive_closure = \&TransitiveClosure_Floyd_Warshall;
+
+sub APSP_Floyd_Warshall {
+    my $self = shift;
+    my $class = ref $self || $self;
+    $self = shift unless ref $self;
+    bless Graph::TransitiveClosure->new($self, path => 1, @_), $class;
+}
+
+*all_pairs_shortest_paths = \&APSP_Floyd_Warshall;
+
+sub _transitive_closure_matrix_compute {
+}
+
+sub transitive_closure_matrix {
+    my $g = shift;
+    my $tcm = $g->get_graph_attribute('_tcm');
+    if (defined $tcm) {
+	if (ref $tcm eq 'ARRAY') { # YECHHH!
+	    if ($tcm->[ 0 ] == $g->[ _G ]) {
+		$tcm = $tcm->[ 1 ];
+	    } else {
+		undef $tcm;
+	    }
+	}
+    }
+    unless (defined $tcm) {
+	my $apsp = $g->APSP_Floyd_Warshall(@_);
+	$tcm = $apsp->get_graph_attribute('_tcm');
+	$g->set_graph_attribute('_tcm', [ $g->[ _G ], $tcm ]);
+    }
+
+    return $tcm;
+}
+
+sub path_length {
+    my $g = shift;
+    my $tcm = $g->transitive_closure_matrix;
+    $tcm->path_length(@_);
+}
+
+sub path_predecessor {
+    my $g = shift;
+    my $tcm = $g->transitive_closure_matrix;
+    $tcm->path_predecessor(@_);
+}
+
+sub path_vertices {
+    my $g = shift;
+    my $tcm = $g->transitive_closure_matrix;
+    $tcm->path_vertices(@_);
+}
+
+sub is_reachable {
+    my $g = shift;
+    my $tcm = $g->transitive_closure_matrix;
+    $tcm->is_reachable(@_);
+}
+
+sub for_shortest_paths {
+    my $g = shift;
+    my $c = shift;
+    my $t = $g->transitive_closure_matrix;
+    my @v = $g->vertices;
+    my $n = 0;
+    for my $u (@v) {
+	for my $v (@v) {
+	    next unless $t->is_reachable($u, $v);
+	    $n++;
+	    $c->($t, $u, $v, $n);
+	}
+    }
+    return $n;
+}
+
+sub _minmax_path {
+    my $g = shift;
+    my $min;
+    my $max;
+    my $minp;
+    my $maxp;
+    $g->for_shortest_paths(sub {
+			       my ($t, $u, $v, $n) = @_;
+			       my $l = $t->path_length($u, $v);
+			       return unless defined $l;
+			       my $p;
+			       if ($u ne $v && (!defined $max || $l > $max)) {
+				   $max = $l;
+				   $maxp = $p = [ $t->path_vertices($u, $v) ];
+			       }
+			       if ($u ne $v && (!defined $min || $l < $min)) {
+				   $min = $l;
+				   $minp = $p || [ $t->path_vertices($u, $v) ];
+			       }
+			   });
+    return ($min, $max, $minp, $maxp);
+}
+
+sub diameter {
+    my $g = shift;
+    my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
+    return defined $maxp ? (wantarray ? @$maxp : $max) : undef;
+}
+
+*graph_diameter = \&diameter;
+
+sub longest_path {
+    my ($g, $u, $v) = @_;
+    my $t = $g->transitive_closure_matrix;
+    if (defined $u) {
+	if (defined $v) {
+	    return wantarray ?
+		$t->path_vertices($u, $v) : $t->path_length($u, $v);
+	} else {
+	    my $max;
+	    my @max;
+	    for my $v ($g->vertices) {
+		next if $u eq $v;
+		my $l = $t->path_length($u, $v);
+		if (defined $l && (!defined $max || $l > $max)) {
+		    $max = $l;
+		    @max = $t->path_vertices($u, $v);
+		}
+	    }
+	    return wantarray ? @max : $max;
+	}
+    } else {
+	if (defined $v) {
+	    my $max;
+	    my @max;
+	    for my $u ($g->vertices) {
+		next if $u eq $v;
+		my $l = $t->path_length($u, $v);
+		if (defined $l && (!defined $max || $l > $max)) {
+		    $max = $l;
+		    @max = $t->path_vertices($u, $v);
+		}
+	    }
+	    return wantarray ? @max : @max - 1;
+	} else {
+	    my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
+	    return defined $maxp ? (wantarray ? @$maxp : $max) : undef;
+	}
+    }
+}
+
+sub vertex_eccentricity {
+    my ($g, $u) = @_;
+    $g->expect_undirected;
+    if ($g->is_connected) {
+	my $max;
+	for my $v ($g->vertices) {
+	    next if $u eq $v;
+	    my $l = $g->path_length($u, $v);
+	    if (defined $l && (!defined $max || $l > $max)) {
+		$max = $l;
+	    }
+	}
+	return $max;
+    } else {
+	return Infinity();
+    }
+}
+
+sub shortest_path {
+    my ($g, $u, $v) = @_;
+    $g->expect_undirected;
+    my $t = $g->transitive_closure_matrix;
+    if (defined $u) {
+	if (defined $v) {
+	    return wantarray ?
+		$t->path_vertices($u, $v) : $t->path_length($u, $v);
+	} else {
+	    my $min;
+	    my @min;
+	    for my $v ($g->vertices) {
+		next if $u eq $v;
+		my $l = $t->path_length($u, $v);
+		if (defined $l && (!defined $min || $l < $min)) {
+		    $min = $l;
+		    @min = $t->path_vertices($u, $v);
+		}
+	    }
+	    return wantarray ? @min : $min;
+	}
+    } else {
+	if (defined $v) {
+	    my $min;
+	    my @min;
+	    for my $u ($g->vertices) {
+		next if $u eq $v;
+		my $l = $t->path_length($u, $v);
+		if (defined $l && (!defined $min || $l < $min)) {
+		    $min = $l;
+		    @min = $t->path_vertices($u, $v);
+		}
+	    }
+	    return wantarray ? @min : $min;
+	} else {
+	    my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
+	    return defined $minp ? (wantarray ? @$minp : $min) : undef;
+	}
+    }
+}
+
+sub radius {
+    my $g = shift;
+    $g->expect_undirected;
+    my ($center, $radius) = (undef, Infinity());
+    for my $v ($g->vertices) {
+	my $x = $g->vertex_eccentricity($v);
+	($center, $radius) = ($v, $x) if defined $x && $x < $radius;
+    }
+    return $radius;
+}
+
+sub center_vertices {
+    my ($g, $delta) = @_;
+    $g->expect_undirected;
+    $delta = 0 unless defined $delta;
+    $delta = abs($delta);
+    my @c;
+    my $r = $g->radius;
+    if (defined $r) {
+	for my $v ($g->vertices) {
+	    my $e = $g->vertex_eccentricity($v);
+	    next unless defined $e;
+	    push @c, $v if abs($e - $r) <= $delta;
+	}
+    }
+    return @c;
+}
+
+*centre_vertices = \&center_vertices;
+
+sub average_path_length {
+    my $g = shift;
+    my @A = @_;
+    my $d = 0;
+    my $m = 0;
+    my $n = $g->for_shortest_paths(sub {
+				       my ($t, $u, $v, $n) = @_;
+				       my $l = $t->path_length($u, $v);
+				       if ($l) {
+					   my $c = @A == 0 ||
+					       (@A == 1 && $u eq $A[0]) ||
+						   ((@A == 2) &&
+						    (defined $A[0] &&
+						     $u eq $A[0]) ||
+						    (defined $A[1] &&
+						     $v eq $A[1]));
+					   if ($c) {
+					       $d += $l;
+					       $m++;
+					   }
+				       }
+				   });
+    return $m ? $d / $m : undef;
+}
+
+###
+# Simple tests.
+#
+
+sub is_multi_graph {
+    my $g = shift;
+    return 0 unless $g->is_multiedged || $g->is_countedged;
+    my $multiedges = 0;
+    for my $e ($g->edges05) {
+	my ($u, @v) = @$e;
+	for my $v (@v) {
+	    return 0 if $u eq $v;
+	}
+	$multiedges++ if $g->get_edge_count(@$e) > 1;
+    }
+    return $multiedges;
+}
+
+sub is_simple_graph {
+    my $g = shift;
+    return 1 unless $g->is_countedged || $g->is_multiedged;
+    for my $e ($g->edges05) {
+	return 0 if $g->get_edge_count(@$e) > 1;
+    }
+    return 1;
+}
+
+sub is_pseudo_graph {
+    my $g = shift;
+    my $m = $g->is_countedged || $g->is_multiedged;
+    for my $e ($g->edges05) {
+	my ($u, @v) = @$e;
+	for my $v (@v) {
+	    return 1 if $u eq $v;
+	}
+	return 1 if $m && $g->get_edge_count($u, @v) > 1;
+    }
+    return 0;
+}
+
+###
+# Rough isomorphism guess.
+#
+
+my %_factorial = (0 => 1, 1 => 1);
+
+sub __factorial {
+    my $n = shift;
+    for (my $i = 2; $i <= $n; $i++) {
+	next if exists $_factorial{$i};
+	$_factorial{$i} = $i * $_factorial{$i - 1};
+    }
+    $_factorial{$n};
+}
+
+sub _factorial {
+    my $n = int(shift);
+    if ($n < 0) {
+	require Carp;
+	Carp::croak("factorial of a negative number");
+    }
+    __factorial($n) unless exists $_factorial{$n};
+    return $_factorial{$n};
+}
+
+sub could_be_isomorphic {
+    my ($g0, $g1) = @_;
+    return 0 unless $g0->vertices == $g1->vertices;
+    return 0 unless $g0->edges05  == $g1->edges05;
+    my %d0;
+    for my $v0 ($g0->vertices) {
+	$d0{ $g0->in_degree($v0) }{ $g0->out_degree($v0) }++
+    }
+    my %d1;
+    for my $v1 ($g1->vertices) {
+	$d1{ $g1->in_degree($v1) }{ $g1->out_degree($v1) }++
+    }
+    return 0 unless keys %d0 == keys %d1;
+    for my $da (keys %d0) {
+	return 0
+	    unless exists $d1{$da} &&
+		   keys %{ $d0{$da} } == keys %{ $d1{$da} };
+	for my $db (keys %{ $d0{$da} }) {
+	    return 0
+		unless exists $d1{$da}{$db} && 
+		       $d0{$da}{$db} == $d1{$da}{$db};
+	}
+    }
+    for my $da (keys %d0) {
+	for my $db (keys %{ $d0{$da} }) {
+	    return 0 unless $d1{$da}{$db} == $d0{$da}{$db};
+	}
+	delete $d1{$da};
+    }
+    return 0 unless keys %d1 == 0;
+    my $f = 1;
+    for my $da (keys %d0) {
+	for my $db (keys %{ $d0{$da} }) {
+	    $f *= _factorial(abs($d0{$da}{$db}));
+	}
+    }
+    return $f;
+}
+
+###
+# Debugging.
+#
+
+sub _dump {
+    require Data::Dumper;
+    my $d = Data::Dumper->new([$_[0]],[ref $_[0]]);
+    defined wantarray ? $d->Dump : print $d->Dump;
+}
+
+1;