1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
package Graph::Undirected;
use strict;
local $^W = 1;
use Graph::Base;
use vars qw(@ISA);
@ISA = qw(Graph::Base);
use overload '""' => \&stringify;
=head1 NAME
Graph::Directed - directed graphs
=head1 SYNOPSIS
use Graph::Directed;
$g = new Graph::Directed;
=head1 DESCRIPTION
See Graph::Base for the available methods.
=head1 COPYRIGHT
Copyright 1999, O'Reilly & Associates.
This code is distributed under the same copyright terms as Perl itself.
=cut
# new
#
# $U = Graph::Undirected->new(@V)
#
# The Constructor. Returns a new undirected graph $U, possibly
# populated with the optional initial vertices @V.
#
sub new {
my $class = shift;
my $G = Graph::Base->new(@_);
bless $G, $class;
$G->directed(0);
return $G;
}
sub stringify {
my $G = shift;
return $G->_stringify("=", ",");
}
sub eq {
my ($G, $H) = @_;
return ref $H ? $G->stringify eq $H->stringify : $G->stringify eq $H;
}
# _edges
#
# @e = $G->_edges($u, $v, $E)
#
# (INTERNAL USE ONLY)
# Both vertices undefined:
# returns all the edges of the graph.
# Both vertices defined:
# returns all the edges between the vertices.
# Only 1st vertex defined:
# returns all the edges at the vertex.
# Only 2nd vertex defined:
# returns all the edges at the vertex.
# The already seen vertices are recorded in $E.
# Edges @e are returned as ($start_vertex, $end_vertex) pairs.
#
sub _edges {
my ($G, $u, $v, $E) = @_;
my @e;
$E = { } unless defined $E;
if (defined $u and defined $v) {
if (exists $G->{ Succ }->{ $u }->{ $v }) {
@e = ($u, $v)
if not $E->{ $u }->{ $v } and
not $E->{ $v }->{ $u };
$E->{ $u }->{ $v } = $E->{ $v }->{ $u } = 1;
}
} elsif (defined $u) {
foreach $v ($G->successors($u)) {
push @e, $G->_edges($u, $v);
}
} elsif (defined $v) {
foreach $u ($G->predecessors($v)) {
push @e, $G->_edges($u, $v);
}
} else {
foreach $u ($G->vertices) {
push @e, $G->_edges($u);
}
}
return @e;
}
1;
|
