?? 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 { @$_ }
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -