File Coverage

blib/lib/Graph/Maker/Hanoi.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


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::Hanoi;
20 1     1   783 use 5.004;
  1         4  
21 1     1   5 use strict;
  1         1  
  1         19  
22 1     1   3 use Carp 'croak';
  1         2  
  1         39  
23 1     1   162 use Graph::Maker;
  0            
  0            
24              
25             use vars '$VERSION','@ISA';
26             $VERSION = 8;
27             @ISA = ('Graph::Maker');
28              
29             # uncomment this to run the ### lines
30             # use Smart::Comments;
31              
32              
33             sub _default_graph_maker {
34             require Graph;
35             Graph->new(@_);
36             }
37              
38             sub _vertex_names_digits {
39             my ($digits, $spindles) = @_;
40             return join('',@$digits);
41             }
42             sub _vertex_names_integer {
43             my ($digits, $spindles) = @_;
44             my $pow = 1;
45             my $ret = 0;
46             foreach my $i (reverse 0 .. $#$digits) {
47             $ret += $digits->[$i] * $pow;
48             $pow *= $spindles;
49             }
50             return $ret;
51             }
52             my %vertex_names = (integer => \&_vertex_names_integer,
53             digits => \&_vertex_names_digits);
54              
55             sub init {
56             my ($self, %params) = @_;
57             my $discs = delete($params{'discs'}) || 0;
58             my $spindles = delete($params{'spindles'}) || 3;
59             my $adjacency = delete($params{'adjacency'}) || 'any';
60             my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;
61              
62             # this not documented yet ...
63             my $vertex_names = delete($params{'vertex_names'}) || 'integer';
64             my $vertex_name_func = $vertex_names{$vertex_names}
65             || croak "Unrecognised vertex_names: ",$vertex_names;
66              
67             my $graph = $graph_maker->(%params);
68              
69             {
70             my $name = "Hanoi $discs";
71             if ($spindles != 3) {
72             $name .= " Discs, $spindles Spindles";
73             }
74             if ($adjacency ne 'any') {
75             $name .= ", \u$adjacency";
76             }
77             $graph->set_graph_attribute (name => $name);
78             }
79              
80             my $offset_limit;
81             if ($adjacency eq 'any' || $adjacency eq 'star') {
82             $offset_limit = $spindles - 1;
83             } elsif ($adjacency eq 'cyclic' || $adjacency eq 'linear') {
84             $offset_limit = 1;
85             } else {
86             croak "Unrecognised adjacency: ",$adjacency;
87             }
88             my $directed = $graph->is_directed;
89             ### $directed
90             ### $offset_limit
91              
92             my @t = (0) x $discs;
93             $graph->add_vertex($vertex_name_func->(\@t, $spindles)); # in case discs=0
94              
95             T: for (;;) {
96             my $v = $vertex_name_func->(\@t, $spindles);
97              
98             my $seen_count = 0;
99             my @seen;
100             foreach my $pos (reverse 0 .. $#t) {
101             my $from_digit = $t[$pos];
102             next if $seen[$from_digit];
103             $seen[$from_digit] = 1;
104             next if $from_digit && $adjacency eq 'star';
105              
106             foreach my $offset (1 .. $offset_limit) {
107             my $to_digit = $from_digit + $offset;
108             if ($adjacency eq 'cyclic') {
109             $to_digit %= $spindles;
110             } else {
111             last if $to_digit >= $spindles;
112             }
113             next if $seen[$to_digit]; # smaller disc on other spindle
114              
115             my @t2 = @t;
116             $t2[$pos] = $to_digit;
117             my $v2 = $vertex_name_func->(\@t2, $spindles);
118             $graph->add_edge($v, $v2);
119             if ($directed) { $graph->add_edge($v2, $v); }
120             ### edge: "pos=$pos @t to @t2"
121             }
122             }
123              
124             # increment t ...
125             foreach my $pos (reverse 0 .. $#t) {
126             next T if ++$t[$pos] < $spindles;
127             $t[$pos] = 0;
128             }
129             last; # no more @t configurations
130             }
131             return $graph;
132              
133              
134              
135              
136              
137             # # smallest disc $t2[-1] moves to either other spindle
138             # foreach (1, 2) {
139             # $t2[-1]++;
140             # $t2[-1] %= 3;
141             # if ($directed || $t2[-1] > $t[-1]) {
142             # my $v2 = $vertex_name_func->(\@t2, $spindles);
143             # ### smallest disc: "$v to $v2"
144             # $graph->add_edge($v, $v2);
145             # }
146             # }
147             #
148             # # on the spindles without the smallest disc, can move the smaller of
149             # # their two top discs
150             # for (my $pos = $#t-1; $pos >= 0; $pos--) {
151             # if ($t[$pos] != $t[-1]) {
152             # @t2 = @t;
153             # $t2[$pos]++;
154             # $t2[$pos] %= 3;
155             # if ($t2[$pos] == $t[-1]) {
156             # $t2[$pos]++;
157             # $t2[$pos] %= 3;
158             # }
159             # if ($directed || $t2[$pos] > $t[$pos]) {
160             # my $v2 = $vertex_name_func->(\@t2, $spindles);
161             # ### second disc: "$v to $v2"
162             # $graph->add_edge($v, $v2);
163             # }
164             # last;
165             # }
166             # }
167             #
168              
169             # # done in integers
170             # if (0) {
171             # my $v_max = 3**$discs - 1;
172             # my $vpad_max = 3**($discs-1) - 1;
173             # ### $discs
174             # ### $v_max
175             # ### $vpad_max
176             #
177             # foreach my $v (0 .. $v_max) {
178             # my $low = $v % 3;
179             # ### $v
180             #
181             # foreach my $inc (1, 2) {
182             # ### $low
183             # ### $inc
184             # my $other = ($low + $inc) % 3;
185             # {
186             # my $v2 = $v - $low + $other;
187             # if ($directed || $v2 > $v) {
188             # ### smallest disc: "$v to $v2"
189             # $graph->add_edge($v, $v2);
190             # }
191             # }
192             #
193             # ### $low
194             # ### $other
195             # my $pad = ($low - $inc) % 3;
196             # my $mod = 3;
197             # my $rem = $low;
198             # foreach (1 .. $discs) {
199             # $mod *= 3;
200             # $rem = 3*$rem + $low;
201             # my $got = $v % $mod;
202             # ### $mod
203             # ### $rem
204             # ### $got
205             # if ($got != $rem) {
206             # my $v2 = $v - $got + ((2*$got - $rem) % $mod);
207             # if ($directed || $v2 > $v) {
208             # ### second smallest: "$v to $v2"
209             # $graph->add_edge($v, $v2);
210             # }
211             # last;
212             # }
213             # }
214             #
215             # # my $pad = ($low - $inc) % 3;
216             # # ### $other
217             # # ### $pad
218             # #
219             # # my $vpad = $v;
220             # # for (;;) {
221             # # ### at: "vpad=$vpad v2=$v2"
222             # # last if $vpad >= $vpad_max || $v2 >= $vpad_max;
223             # # $vpad = 3*$vpad + $pad;
224             # # $v2 = 3*$v2 + $pad;
225             # # if ($directed || $v2 > $vpad) {
226             # # ### second smallest: "$vpad to $v2"
227             # # }
228             # # $graph->add_edge($vpad, $v2);
229             # # }
230             # }
231             # }
232             # }
233             #
234             # return $graph;
235             }
236              
237             Graph::Maker->add_factory_type('hanoi' => __PACKAGE__);
238             1;
239              
240             __END__