File Coverage

blib/lib/Graph/Maker/Keller.pm
Criterion Covered Total %
statement 6 8 75.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 9 11 81.8


line stmt bran cond sub pod time code
1             # Copyright 2015, 2016, 2017 Kevin Ryde
2             #
3             # This file is part of Graph-Maker-Other.
4             #
5             # This file is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # This file is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Graph-Maker-Other. See the file COPYING. If not, see
17             # .
18              
19             package Graph::Maker::Keller;
20 1     1   1092 use 5.004;
  1         3  
21 1     1   4 use strict;
  1         2  
  1         17  
22 1     1   114 use Graph::Maker;
  0            
  0            
23              
24             use vars '$VERSION','@ISA';
25             $VERSION = 8;
26             @ISA = ('Graph::Maker');
27              
28              
29             sub _default_graph_maker {
30             require Graph;
31             Graph->new(@_);
32             }
33              
34             sub _is_edge {
35             my ($from,$to) = @_;
36             my $diff = $from ^ $to;
37             my $seen_two = 0;
38             my $seen_any = 0;
39             while ($diff) {
40             my $digit = $diff & 3;
41             if ($digit) { $seen_any++; }
42             if ($digit == 2) { $seen_two++; }
43             if ($seen_any >= 2 && $seen_two) {
44             return 1;
45             }
46             $diff >>= 2;
47             }
48             return 0;
49             }
50              
51             sub init {
52             my ($self, %params) = @_;
53              
54             my $N = delete($params{'N'}) || 0;
55             my $subgraph = delete($params{'subgraph'}) || 0;
56             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
57              
58             my $graph = $graph_maker->(%params);
59              
60             my $directed = $graph->is_directed;
61              
62             if ($subgraph) {
63             $graph->set_graph_attribute (name => "Keller Subgraph $N");
64              
65             my @vertices;
66             foreach my $to (1 .. (1 << (2*$N))-1) {
67             if (_is_edge(0,$to)) {
68             $graph->add_vertex($to);
69             push @vertices, $to;
70             }
71             }
72             foreach my $i (0 .. $#vertices) {
73             my $from = $vertices[$i];
74             foreach my $j ($i+1 .. $#vertices) {
75             my $to = $vertices[$j];
76             if (_is_edge($from,$to)) {
77             if ($directed) { $graph->add_edge($to, $from); }
78             $graph->add_edge($from, $to);
79             }
80             }
81             }
82              
83             } else {
84             $graph->set_graph_attribute (name => "Keller $N");
85              
86             my $max_vertex = (1 << (2*$N)) - 1;
87             for my $from (0 .. $max_vertex) {
88             $graph->add_vertex($from); # for $N < 2 where there are no edges
89              
90             for my $to ($from+1 .. $max_vertex) {
91             if (_is_edge($from,$to)) {
92             $graph->add_edge($from, $to);
93             if ($directed) { $graph->add_edge($to, $from); }
94             }
95             }
96             }
97             }
98             return $graph;
99             }
100              
101             Graph::Maker->add_factory_type('Keller' => __PACKAGE__);
102             1;
103              
104              
105              
106              
107              
108             # for (my($i,$imask) = (0,1);
109             # $i < $N;
110             # $i++, $imask <<= 2) {
111             # foreach my $ixor ($imask, 2*$imask, 3*$imask) {
112             # my $in = $n ^ $ixor;
113             #
114             # for (my($j,$jmask) = (0,2);
115             # $j < $N;
116             # $j++, $jmask <<= 2) {
117             # next if $i == $j;
118             #
119             # my $n2 = $in ^ $jmask;
120             # if ($directed || $n2 > $n) {
121             # $graph->add_edge($n, $n2);
122             # }
123             # }
124             # }
125             # }
126              
127              
128             __END__