-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathGraph.pm
152 lines (122 loc) · 3.49 KB
/
Graph.pm
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
package Graph;
#use strict;
#use warnings;
use Graph::Node;
#########################################
## Class Functions #
#########################################
# Constructor
sub new {
my $class = shift;
my $self = {
_nodes => [@_],
};
bless ($self, $class);
return $self;
}
# Getter for nodes
sub nodes {
my ($self) = @_;
return @{$self->{_nodes}};
}
# Getter for edges
sub edges {
my ($self) = @_;
my $edges = {};
for my $node ($self->nodes()) {
for my $other ($node->adjacent_nodes()) {
my $key = $node->edge_key ($other);
$edges->{$key} = [$node, $other]
unless (exists $edges->{$key});
}
}
return $edges;
}
# Getter for start/end nodes. In this case defined by the nodes with the
# furthest distance, that does not have a direct link.
sub endpoints {
my ($self) = @_;
my ($start, $end, $dist) = (undef, undef, undef);
for my $node ($self->nodes()) {
# Select non-adjacent nodes, calculate distance, sort and select the
# furthest node.
my @possibles =
sort { $b->[1] <=> $a->[1] }
map { [$_, $_->calc_distance ($node)] }
grep { not $node->connects($_) }
$self->nodes();
if (scalar @possibles) {
if (not defined $dist or
$possibles[0]->[1] > $dist) {
$start = $node;
$end = $possibles[0]->[0];
$dist = $possibles[0]->[1];
}
}
}
return ($start, $end);
}
# Add a node
sub insert {
my ($self, $node) = @_;
push ($self->{_nodes}, $node);
}
# Empty the graph
sub clear {
my ($self) = @_;
$self->{_nodes} = [];
}
# Print out the degree sequence
sub degree_seq {
my ($self) = @_;
return sort { $b <=> $a } map { $_->degree() } $self->nodes();
}
# Print out adjacency lists
sub str {
my ($self, %args) = @_;
# Fix the index of the nodes, to allow an internally consistent
# representation.
my %index; # Translate node to index
my @nodelist; # Translate index to node
{
my $i = 0;
for (@{$self->{_nodes}}) {
$index{$_} = $i;
push (@nodelist, $_);
++$i;
}
}
# Print each node like so:
# index:coord:adjacent nodes
# | | | | |
# | | | | | ,| Integer identifier for this node. Padded
# `--|--|--|----|-----|| with 0 or more spaces on the left side
# | | | | `| to make it more readable.
# | | | |
# | | | | ,|
# `-|--+----|-----|| Field separators are a single colon (:)
# | | `|
# | |
# | | ,| The coordinates of the node, in the form:
# '-------|-----|| (x,y). x and y are integers.
# | `|
# |
# | ,| List of the indexes of the nodes adjacent
# '-----|| to the current node. The nodes indexes are
# `| separated by one or more spaces.
# Nodes
my $output = join (
$/,
map {
sprintf (
"%d:%s:%s",
$index{$_}, $_->str(),
join (
' ',
map { sprintf('%d', $index{$_} ) } $_->adjacent_nodes()
)
) } @nodelist
);
return $output;
}
1;