File Coverage

blib/lib/Graph/Undirected/Hamiltonicity/Spoof.pm
Criterion Covered Total %
statement 73 73 100.0
branch 23 24 95.8
condition 11 15 73.3
subroutine 10 10 100.0
pod 4 5 80.0
total 121 127 95.2


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