File Coverage

blib/lib/Math/PlanePath/Flowsnake.pm
Criterion Covered Total %
statement 51 119 42.8
branch 9 36 25.0
condition 7 9 77.7
subroutine 10 16 62.5
pod 7 7 100.0
total 84 187 44.9


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath 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             # Math-PlanePath 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 Math-PlanePath. If not, see .
17              
18              
19             # math-image --path=Flowsnake --lines --scale=10
20             # math-image --path=Flowsnake --all --output=numbers_dash
21             # math-image --path=Flowsnake,arms=3 --all --output=numbers_dash
22             #
23             # Martin Gardner, "In which `Monster' Curves Force Redefinition of the Word
24             # `Curve'", Scientific American 235, December 1976, pages 124-133.
25             #
26             # http://80386.nl/pub/gosper-level21.png
27             #
28             # http://www.mathcurve.com/fractals/gosper/gosper.shtml
29             #
30             # plain hexagonal tiling http://tilingsearch.org/HTML/data136/F666.html
31              
32             # http://complex-systems.com/pdf/24-4-1.pdf
33             # http://complex-systems.com/issues/24-4.html
34              
35             # Jeffrey Ventrella
36             # root-7 family
37             # "inner-flip" which is initial state reversal
38              
39              
40              
41             package Math::PlanePath::Flowsnake;
42 1     1   8886 use 5.004;
  1         10  
43 1     1   7 use strict;
  1         2  
  1         25  
44              
45 1     1   4 use vars '$VERSION', '@ISA';
  1         8  
  1         72  
46             $VERSION = 128;
47              
48             # inherit: new(), rect_to_n_range(), arms_count(), n_start(),
49             # parameter_info_array(), xy_is_visited()
50 1     1   551 use Math::PlanePath::FlowsnakeCentres 55; # v.55 inheritance switch-around
  1         18  
  1         44  
51             @ISA = ('Math::PlanePath::FlowsnakeCentres');
52 1     1   8 use Math::PlanePath;
  1         2  
  1         34  
53             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
54              
55             use Math::PlanePath::Base::Generic
56 1         61 'is_infinite',
57 1     1   6 'round_nearest';
  1         2  
58             use Math::PlanePath::Base::Digits
59 1         1629 'digit_split_lowtohigh',
60 1     1   6 'round_up_pow';
  1         2  
61              
62             # uncomment this to run the ### lines
63             # use Smart::Comments;
64              
65              
66             # (i,j)*(2+w) = (2i-j,2j+i+j) = (2i-j,3j+i)
67             # (x,y)*(2+w) = 2x + (x-3y)/2, 2y + (x+y)/2
68             # = (4x + x-3y)/2, (4y + x+y)/2
69             # = (5x-3y)/2, (x+5y)/2
70              
71             {
72             my @x_negative_at_n = (undef, 23, 1, 1);
73             sub x_negative_at_n {
74 0     0 1 0 my ($self) = @_;
75 0         0 return $x_negative_at_n[$self->{'arms'}];
76             }
77             }
78             {
79             my @y_negative_at_n = (undef, 8598, 7, 2);
80             sub y_negative_at_n {
81 0     0 1 0 my ($self) = @_;
82 0         0 return $y_negative_at_n[$self->{'arms'}];
83             }
84             }
85              
86             {
87             my @_UNDOCUMENTED__dxdy_list_at_n = (undef, 11, 6, 9);
88             sub _UNDOCUMENTED__dxdy_list_at_n {
89 0     0   0 my ($self) = @_;
90 0         0 return $_UNDOCUMENTED__dxdy_list_at_n[$self->{'arms'}];
91             }
92             }
93              
94             # Table generated by tools/flowsnake-table.pl.
95             # next_state length 84
96             my @next_state = (0, 21,49,28, 0, 0,77, 70, 7, 7,35,42,14, 7, # 0,7
97             14,35,63,42,14,14, 7, 0,21,21,49,56,28,21, # 14,21
98             28,49,77,56,28,28,21, 14,35,35,63,70,42,35, # 28,35
99             42,63, 7,70,42,42,35, 28,49,49,77, 0,56,49, # 42,49
100             56,77,21, 0,56,56,49, 42,63,63, 7,14,70,63, # 56,63
101             70, 7,35,14,70,70,63, 56,77,77,21,28, 0,77); # 70,77
102             my @digit_to_i = (0, 1, 1, 0,-1, 0, 1, 0, 1, 2, 3, 2, 1, 1, # 0,7
103             0, 0,-1,-1,-2,-2,-2, 0, 1, 1, 1, 0, 0,-1, # 14,21
104             0, -1,-2,-1,-1,-2,-3, 0, 0,-1,-2,-2,-1,-2, # 28,35
105             0, -1,-1, 0, 1, 0,-1, 0,-1,-2,-3,-2,-1,-1, # 42,49
106             0, 0, 1, 1, 2, 2, 2, 0,-1,-1,-1, 0, 0, 1, # 56,63
107             0, 1, 2, 1, 1, 2, 3, 0, 0, 1, 2, 2, 1,2); # 70,77
108             my @digit_to_j = (0, 0, 1, 1, 2, 2, 2, 0,-1,-1,-1, 0, 0, 1, # 0,7
109             0, 1, 2, 1, 1, 2, 3, 0, 0, 1, 2, 2, 1, 2, # 14,21
110             0, 1, 1, 0,-1, 0, 1, 0, 1, 2, 3, 2, 1, 1, # 28,35
111             0, 0,-1,-1,-2,-2,-2, 0, 1, 1, 1, 0, 0,-1, # 42,49
112             0, -1,-2,-1,-1,-2,-3, 0, 0,-1,-2,-2,-1,-2, # 56,63
113             0, -1,-1, 0, 1, 0,-1, 0,-1,-2,-3,-2,-1,-1); # 70,77
114              
115             # state 0 to 11
116             my @dir6_to_di = (1, 0,-1, -1, 0, 1);
117             my @dir6_to_dj = (0, 1, 1, 0,-1,-1);
118              
119             sub n_to_xy {
120 8918     8918 1 29534 my ($self, $n) = @_;
121             ### Flowsnake n_to_xy(): $n
122              
123 8918 50       16303 if ($n < 0) { return; }
  0         0  
124 8918 50       16562 if (is_infinite($n)) { return ($n,$n); }
  0         0  
125              
126 8918         15694 my $int = int($n);
127 8918         13049 $n -= $int; # fraction part
128             ### $int
129             ### frac: $n
130              
131 8918         11271 my $state;
132             {
133 8918         11205 my $arm = _divrem_mutate ($int, $self->{'arms'});
  8918         18689  
134 8918         13771 $state = 28 * $arm; # initial rotation
135              
136             # adjust so that for arms=2 point N=1 has $int==1
137             # or for arms=3 then points N=1 and N=2 have $int==1
138 8918 100       15551 if ($arm) { $int += 1; }
  184         268  
139             }
140             ### initial state: $state
141              
142 8918         12802 my $i = my $j = $int*0; # bignum zero
143              
144 8918         16518 foreach my $digit (reverse digit_split_lowtohigh($int,7)) { # high to low
145             ### at: "state=$state digit=$digit i=$i,j=$j di=".$digit_to_i[$state+$digit]." dj=".$digit_to_j[$state+$digit]
146              
147             # (i,j) *= (2+w), being (i,j) = 2*(i,j)+rot60(i,j)
148             # then add low digit pos
149             #
150 33986         43568 $state += $digit;
151 33986         57855 ($i, $j) = (2*$i - $j + $digit_to_i[$state],
152             3*$j + $i + $digit_to_j[$state]);
153 33986         48209 $state = $next_state[$state];
154             }
155             ### integer: "i=$i, j=$j"
156              
157             # fraction in final $state direction
158 8918 100       16473 if ($n) {
159             ### apply: "frac=$n state=$state"
160 63         141 $state = int($state/14); # divide to direction 0 to 5
161 63         115 $i = $n * $dir6_to_di[$state] + $i;
162 63         90 $j = $n * $dir6_to_dj[$state] + $j;
163             }
164              
165             ### ret: "$i, $j x=".(2*$i+$j)." y=$j"
166 8918         21737 return (2*$i+$j,
167             $j);
168              
169             }
170              
171             # Table generated by tools/flowsnake-table.pl.
172             my @digit_to_next_di
173             = (0, -1,-1, 1, 1, 1,undef, 1, 1,-1,-1, 0, 1,undef, # 0,7
174             -1, 0,-1, 0, 0, 1,undef, 0, 0,-1, 0,-1, 0,undef, # 14,21
175             -1, 1, 0,-1,-1, 0,undef, -1,-1, 0, 1,-1,-1,undef, # 28,35
176             0, 1, 1,-1,-1,-1,undef, -1,-1, 1, 1, 0,-1,undef, # 42,49
177             1, 0, 1, 0, 0,-1,undef, 0, 0, 1, 0, 1, 0,undef, # 56,63
178             1, -1, 0, 1, 1, 0,undef, 1, 1, 0,-1, 1, 1,undef, # 70,77
179             1, -1,-1, 1, 1, 0,undef, 1, 1, 0,-1, 0, 1,undef, # 84,91
180             0, -1,-1, 0, 0, 1,undef, 1, 1,-1, 0,-1, 1,undef, # 98,105
181             -1, 0, 0,-1,-1, 1,undef, 0, 0,-1, 1,-1, 0,undef, # 112,119
182             -1, 1, 1,-1,-1, 0,undef, -1,-1, 0, 1, 0,-1,undef, # 126,133
183             0, 1, 1, 0, 0,-1,undef, -1,-1, 1, 0, 1,-1,undef, # 140,147
184             1, 0, 0, 1, 1,-1,undef, 0, 0, 1,-1, 1,0);
185             my @digit_to_next_dj
186             = (1, 0, 1, 0, 0,-1,undef, 0, 0, 1, 0, 1, 0,undef, # 0,7
187             1, -1, 0, 1, 1, 0,undef, 1, 1, 0,-1, 1, 1,undef, # 14,21
188             0, -1,-1, 1, 1, 1,undef, 1, 1,-1,-1, 0, 1,undef, # 28,35
189             -1, 0,-1, 0, 0, 1,undef, 0, 0,-1, 0,-1, 0,undef, # 42,49
190             -1, 1, 0,-1,-1, 0,undef, -1,-1, 0, 1,-1,-1,undef, # 56,63
191             0, 1, 1,-1,-1,-1,undef, -1,-1, 1, 1, 0,-1,undef, # 70,77
192             0, 1, 1, 0, 0,-1,undef, -1,-1, 1, 0, 1,-1,undef, # 84,91
193             1, 0, 0, 1, 1,-1,undef, 0, 0, 1,-1, 1, 0,undef, # 98,105
194             1, -1,-1, 1, 1, 0,undef, 1, 1, 0,-1, 0, 1,undef, # 112,119
195             0, -1,-1, 0, 0, 1,undef, 1, 1,-1, 0,-1, 1,undef, # 126,133
196             -1, 0, 0,-1,-1, 1,undef, 0, 0,-1, 1,-1, 0,undef, # 140,147
197             -1, 1, 1,-1,-1, 0,undef, -1,-1, 0, 1, 0,-1);
198              
199             sub n_to_dxdy {
200 0     0 1 0 my ($self, $n) = @_;
201             ### Flowsnake n_to_dxdy(): $n
202              
203 0 0       0 if ($n < 0) { return; }
  0         0  
204 0 0       0 if (is_infinite($n)) { return ($n,$n); }
  0         0  
205              
206 0         0 my $int = int($n);
207 0         0 $n -= $int; # fraction part
208             ### $int
209             ### frac: $n
210              
211 0         0 my $state;
212             {
213 0         0 my $arm = _divrem_mutate ($int, $self->{'arms'});
  0         0  
214 0         0 $state = 28 * $arm; # initial rotation
215              
216             # adjust so that for arms=2 point N=1 has $int==1
217             # or for arms=3 then points N=1 and N=2 have $int==1
218 0 0       0 if ($arm) { $int += 1; }
  0         0  
219             }
220             ### initial state: $state
221              
222 0         0 my $turn_state = $state;
223 0         0 my $turn_notlow = 0;
224 0         0 foreach my $digit (reverse digit_split_lowtohigh($int,7)) { # high to low
225             ### $digit
226 0         0 $state += $digit;
227              
228 0 0       0 if ($digit == 6) {
229 0         0 $turn_notlow = 84; # is not the least significant digit
230             } else {
231 0         0 $turn_state = $state; # lowest non-6
232 0         0 $turn_notlow = 0; # and is the least significant digit
233             }
234 0         0 $state = $next_state[$state];
235             }
236             ### int digits state: $state
237             ### $turn_state
238             ### $turn_notlow
239              
240 0         0 $state = int($state/14);
241 0         0 my $di = $dir6_to_di[$state];
242 0         0 my $dj = $dir6_to_dj[$state];
243             ### int direction: "di=$di, dj=$dj"
244              
245             # fraction in final $state direction
246 0 0       0 if ($n) {
247 0         0 $turn_state += $turn_notlow;
248 0         0 my $next_di = $digit_to_next_di[$turn_state];
249 0         0 my $next_dj = $digit_to_next_dj[$turn_state];
250              
251             ### $next_di
252             ### $next_dj
253              
254 0         0 $di += $n*($next_di - $di);
255 0         0 $dj += $n*($next_dj - $dj);
256              
257             ### with frac: "di=$di, dj=$dj"
258             }
259              
260             ### ret: "dx=".(2*$di+$dj)." dy=$dj"
261 0         0 return (2*$di+$dj,
262             $dj);
263              
264             }
265              
266             my @attempt_dx = (0, -2, -1);
267             my @attempt_dy = (0, 0, -1);
268             sub xy_to_n {
269 62     62 1 1595 my ($self, $x, $y) = @_;
270             ### Flowsnake xy_to_n(): "$x, $y"
271              
272 62         143 $x = round_nearest($x);
273 62         144 $y = round_nearest($y);
274 62 50       148 if (($x + $y) % 2) { return undef; }
  0         0  
275             ### round to: "$x,$y"
276              
277 62         104 my ($n, $cx, $cy);
278 62         111 foreach my $i (0, 1, 2) {
279 110 100 66     397 if (defined ($n = $self->SUPER::xy_to_n($x + $attempt_dx[$i],
      100        
      66        
280             $y + $attempt_dy[$i]))
281             && (($cx,$cy) = $self->n_to_xy($n))
282             && $x == $cx
283             && $y == $cy) {
284 62         182 return $n;
285             }
286             }
287 0         0 return undef;
288             }
289              
290             # 0 straight
291             # 1 +60 rev
292             # 2 180 rev
293             # 3 +240
294             # 4 straight
295             # 5 straight
296             # 6 -60 rev
297              
298             # 4---- 5---- 6
299             # \ \
300             # 3---- 2 7
301             # /
302             # 0---- 1
303             #
304             # turn(N) = tdir6(N)-tdir6(N-1)
305             # N-1 changes low 0s to low 6s
306             # N = aaad000
307             # N-1 = aaac666
308             # low 0s no change to direction
309             # low 6s state 7
310             # N=14=20[7] dir[2]=3,dirrev[0]=5 total 3+5=2mod6
311             # N-1=13=16[7] dir[1]=1,dirrev[6]=0 total 1+0=1 diff 2-1=1
312             # dir[2]-dir[1]=2
313             # dirrev[0] since digit=2 goes to rev
314             # N=23=32[7]
315              
316             # 0 1 2 3 4 5
317             my @turn6 = (1, 2,-1,-2, 0,-1, # forward
318             1, 0, 2, 1,-2,-1, # reverse
319             #
320             1, 1,-1,-1, 1,-1, # 0,0,-1,0,+1,+1,0
321             1,-1, 1, 1,-1,-1, # 0,0,-1,-1,0,+1,0
322             );
323             my @digit_to_reverse = (-1,5,5,undef,-1,-1,5); # -1=forward,5=reverse
324             sub _WORKING_BUT_SECRET__n_to_turn6 {
325 0     0   0 my ($self, $n) = @_;
326 0 0       0 unless ($n >= 1) {
327 0         0 return undef;
328             }
329 0 0       0 if (is_infinite($n)) {
330 0         0 return $n;
331             }
332              
333 0         0 my $lowdigit = _divrem_mutate($n,7);
334             ### $lowdigit
335              
336             # skip low 0 digits
337 0 0       0 unless ($lowdigit) {
338 0         0 while ($n) {
339 0 0       0 last if ($lowdigit = _divrem_mutate($n,7)); # stop at non-zero
340             }
341             # flag that some zeros were skipped
342 0         0 $lowdigit += 12;
343             ### $lowdigit
344             }
345              
346             # Forward/reverse reverse from lowest non-3.
347             # Digit parts 0,4,5 always forward, 1,2,6 always reverse,
348             # 3 is unchanged so following the digit above it.
349 0         0 for (;;) {
350 0         0 my $digit = _divrem_mutate($n,7);
351 0 0       0 if ($digit != 3) {
352 0         0 $lowdigit += $digit_to_reverse[$digit];
353 0         0 last;
354             }
355             }
356              
357             ### lookup: $lowdigit
358 0         0 return $turn6[$lowdigit];
359             }
360              
361             #------------------------------------------------------------------------------
362             # levels
363              
364             # arms=1 arms=2 arms=3
365             # level 0 0..1 = 2 0..2 = 2+1=3 0..3 = 2+1+1=4
366             # level 1 0..7 = 8 0..14 = 8+7=15 0..21 = 8+7+7=22
367             # level 2 0..49 = 50 0..98 = 50+49=99 0..147 = 50+49+49=148
368             # 7^k 2*7^k 3*7^k
369             #
370             sub level_to_n_range {
371 8     8 1 489 my ($self, $level) = @_;
372 8         24 return (0, 7**$level * $self->{'arms'});
373             }
374             sub n_to_level {
375 0     0 1   my ($self, $n) = @_;
376             ### n_to_level(): $n
377 0 0         if ($n < 0) { return undef; }
  0            
378 0 0         if (is_infinite($n)) { return $n; }
  0            
379 0           $n = round_nearest($n);
380 0           $n += $self->{'arms'}-1; # division rounding up
381 0           _divrem_mutate ($n, $self->{'arms'});
382 0           my ($pow, $exp) = round_up_pow ($n, 7);
383 0           return $exp;
384             }
385              
386             #------------------------------------------------------------------------------
387             1;
388             __END__