BR 812417: Deadman counter for macro expansion

[nasm.git] / perllib / Graph.pm

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;