line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Graph::Undirected::Hamiltonicity::Spoof; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
36784
|
use Modern::Perl; |
|
5
|
|
|
|
|
37
|
|
|
5
|
|
|
|
|
30
|
|
4
|
5
|
|
|
5
|
|
650
|
use Carp; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
263
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
1212
|
use Graph::Undirected; |
|
5
|
|
|
|
|
103606
|
|
|
5
|
|
|
|
|
141
|
|
7
|
5
|
|
|
5
|
|
1716
|
use Graph::Undirected::Hamiltonicity::Transforms qw(&add_random_edges &get_random_isomorph); |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
648
|
|
8
|
|
|
|
|
|
|
|
9
|
5
|
|
|
5
|
|
40
|
use Exporter qw(import); |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
3622
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
12
|
|
|
|
|
|
|
&spoof_canonical_hamiltonian_graph |
13
|
|
|
|
|
|
|
&spoof_known_hamiltonian_graph |
14
|
|
|
|
|
|
|
&spoof_random_graph |
15
|
|
|
|
|
|
|
&spoof_randomish_graph |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( all => \@EXPORT_OK, ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
############################################################################## |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub spoof_canonical_hamiltonian_graph { |
23
|
32
|
|
|
32
|
1
|
9742
|
my ($v) = @_; |
24
|
|
|
|
|
|
|
|
25
|
32
|
|
|
|
|
73
|
my $last_vertex = $v - 1; |
26
|
32
|
|
|
|
|
117
|
my @vertices = ( 0 .. $last_vertex ); |
27
|
|
|
|
|
|
|
|
28
|
32
|
|
|
|
|
203
|
my $g = Graph::Undirected->new( vertices => \@vertices ); |
29
|
32
|
|
|
|
|
16587
|
$g->add_edge( 0, $last_vertex ); |
30
|
|
|
|
|
|
|
|
31
|
32
|
|
|
|
|
19444
|
for ( my $i = 0; $i < $last_vertex; $i++ ) { |
32
|
276
|
|
|
|
|
23942
|
$g->add_edge( $i, $i + 1 ); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
32
|
|
|
|
|
2972
|
return $g; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
############################################################################## |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub spoof_known_hamiltonian_graph { |
41
|
25
|
|
|
25
|
1
|
19838
|
my ( $v, $e ) = @_; |
42
|
|
|
|
|
|
|
|
43
|
25
|
100
|
66
|
|
|
173
|
croak "Please provide the number of vertices." unless defined $v and $v; |
44
|
24
|
100
|
|
|
|
89
|
croak "A graph with 2 vertices cannot be Hamiltonian." if $v == 2; |
45
|
|
|
|
|
|
|
|
46
|
23
|
|
66
|
|
|
84
|
$e ||= get_random_edge_count($v); |
47
|
|
|
|
|
|
|
|
48
|
23
|
100
|
|
|
|
70
|
croak "The number of edges must be >= number of vertices." if $e < $v; |
49
|
|
|
|
|
|
|
|
50
|
22
|
|
|
|
|
70
|
my $g = spoof_canonical_hamiltonian_graph($v); |
51
|
22
|
|
|
|
|
119
|
$g = get_random_isomorph($g); |
52
|
22
|
100
|
|
|
|
148
|
$g = add_random_edges( $g, $e - $v ) if ( $e - $v ) > 0; |
53
|
|
|
|
|
|
|
|
54
|
22
|
|
|
|
|
111
|
return $g; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
############################################################################## |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub spoof_random_graph { |
60
|
|
|
|
|
|
|
|
61
|
44
|
|
|
44
|
1
|
16787
|
my ( $v, $e ) = @_; |
62
|
44
|
|
66
|
|
|
218
|
$e //= get_random_edge_count($v); |
63
|
|
|
|
|
|
|
|
64
|
44
|
|
|
|
|
318
|
my $g = Graph::Undirected->new( vertices => [ 0 .. $v-1 ] ); |
65
|
44
|
50
|
|
|
|
21650
|
$g = add_random_edges( $g, $e ) if $e; |
66
|
|
|
|
|
|
|
|
67
|
44
|
|
|
|
|
144
|
return $g; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
############################################################################## |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub spoof_randomish_graph { |
73
|
|
|
|
|
|
|
|
74
|
22
|
|
|
22
|
1
|
219952
|
my ( $v, $e ) = @_; |
75
|
22
|
|
66
|
|
|
148
|
$e ||= get_random_edge_count($v); |
76
|
|
|
|
|
|
|
|
77
|
22
|
|
|
|
|
109
|
my $g = spoof_random_graph( $v, $e ); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
### Seek out vertices with degree < 2 |
80
|
|
|
|
|
|
|
### and add random edges to them. |
81
|
22
|
|
|
|
|
60
|
my $edges_to_remove = 0; |
82
|
22
|
|
|
|
|
107
|
foreach my $vertex1 ( $g->vertices() ) { |
83
|
253
|
|
|
|
|
1190
|
my $degree = $g->degree($vertex1); |
84
|
|
|
|
|
|
|
|
85
|
253
|
100
|
|
|
|
98001
|
next if $degree > 1; |
86
|
31
|
|
|
|
|
59
|
my $added_edges = 0; |
87
|
31
|
|
|
|
|
106
|
while ( $added_edges < (2 - $degree) ) { |
88
|
51
|
|
|
|
|
263
|
my $vertex2 = int( rand($v) ); |
89
|
51
|
100
|
|
|
|
117
|
next if $vertex1 == $vertex2; |
90
|
46
|
100
|
|
|
|
120
|
next if $g->has_edge($vertex1, $vertex2); |
91
|
42
|
|
|
|
|
1869
|
$g->add_edge($vertex1,$vertex2); |
92
|
42
|
|
|
|
|
4463
|
$added_edges++; |
93
|
42
|
|
|
|
|
120
|
$edges_to_remove++; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
22
|
|
|
|
|
115
|
my $try_count = 0; |
98
|
22
|
|
|
|
|
66
|
my $max_tries = 2 * $edges_to_remove; |
99
|
|
|
|
|
|
|
### Seek out vertices with degree > 2 |
100
|
|
|
|
|
|
|
### with neighbor of degree < 3 |
101
|
|
|
|
|
|
|
### and delete edges. |
102
|
|
|
|
|
|
|
### Try to delete the same number of edges, |
103
|
|
|
|
|
|
|
### as the random edges added. |
104
|
22
|
|
100
|
|
|
161
|
while ( $edges_to_remove and ($try_count < $max_tries) ) { |
105
|
75
|
|
|
|
|
10893
|
$try_count++; |
106
|
|
|
|
|
|
|
LOOP: |
107
|
75
|
|
|
|
|
330
|
foreach my $vertex1 ( $g->vertices() ) { |
108
|
649
|
100
|
|
|
|
125929
|
next if $g->degree($vertex1) < 3; |
109
|
|
|
|
|
|
|
|
110
|
127
|
|
|
|
|
35685
|
foreach my $vertex2 ( $g->neighbors($vertex1) ) { |
111
|
431
|
100
|
|
|
|
74186
|
next if $g->degree($vertex2) < 3; |
112
|
21
|
|
|
|
|
5792
|
$g->delete_edge($vertex1,$vertex2); |
113
|
21
|
|
|
|
|
2149
|
$edges_to_remove--; |
114
|
21
|
|
|
|
|
160
|
last LOOP; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
22
|
100
|
|
|
|
3153
|
carp "Exiting with $edges_to_remove extra edges.\n" if $edges_to_remove; |
120
|
|
|
|
|
|
|
|
121
|
22
|
|
|
|
|
183
|
return $g; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
############################################################################## |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub get_random_edge_count { |
127
|
33
|
|
|
33
|
0
|
87
|
my ( $v ) = @_; |
128
|
|
|
|
|
|
|
|
129
|
33
|
|
|
|
|
168
|
my %h = ( 0 => 0, 1 => 0, 2 => 1, 3 => 3, 4 => 4 ); |
130
|
33
|
|
|
|
|
77
|
my $e = $h{$v}; |
131
|
33
|
100
|
|
|
|
136
|
return $e if defined $e; |
132
|
|
|
|
|
|
|
|
133
|
27
|
|
|
|
|
95
|
my $max_edges = ( $v * $v - $v ) / 2; |
134
|
27
|
|
|
|
|
81
|
my $range = $max_edges - 2 * $v + 2; |
135
|
27
|
|
|
|
|
86
|
$e = int( rand( $range ) ) + $v; |
136
|
|
|
|
|
|
|
|
137
|
27
|
|
|
|
|
113
|
return $e; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
############################################################################## |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
1; # End of Graph::Undirected::Hamiltonicity::Spoof |