File Coverage

blib/lib/Math/PlanePath/CellularRule.pm
Criterion Covered Total %
statement 441 649 67.9
branch 90 224 40.1
condition 32 75 42.6
subroutine 98 163 60.1
pod 22 22 100.0
total 683 1133 60.2


line stmt bran cond sub pod time code
1             # Copyright 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
6             # it under the terms of the GNU General Public License as published by the
7             # Free 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              
20             # math-image --path=CellularRule --all --scale=10
21             #
22             # math-image --path=CellularRule --all --output=numbers --size=80x50
23              
24             # Maybe:
25             # @rules = Math::PlanePath::CellularRule->rule_equiv_list($rule)
26             # list of equivalents
27             # $bool = Math::PlanePath::CellularRule->rules_are_equiv($rule1,$rule2)
28             # $rule = Math::PlanePath::CellularRule->rule_to_first($rule)
29             # first equivalent
30             # $bool = Math::PlanePath::CellularRule->rules_are_mirror($rule1,$rule2)
31             # $rule = Math::PlanePath::CellularRule->rule_to_mirror($rule)
32             # or undef if no mirror
33             # $bool = Math::PlanePath::CellularRule->rule_is_symmetric($rule)
34              
35              
36              
37             package Math::PlanePath::CellularRule;
38 1     1   1519 use 5.004;
  1         3  
39 1     1   5 use strict;
  1         2  
  1         22  
40 1     1   5 use Carp 'croak';
  1         1  
  1         47  
41              
42 1     1   6 use vars '$VERSION', '@ISA';
  1         1  
  1         69  
43             $VERSION = 129;
44 1     1   799 use Math::PlanePath;
  1         3  
  1         41  
45             @ISA = ('Math::PlanePath');
46              
47             use Math::PlanePath::Base::Generic
48 1         40 'is_infinite',
49 1     1   7 'round_nearest';
  1         2  
50              
51 1     1   646 use Math::PlanePath::CellularRule54;
  1         3  
  1         41  
52             *_rect_for_V = \&Math::PlanePath::CellularRule54::_rect_for_V;
53              
54              
55             # uncomment this to run the ### lines
56             # use Smart::Comments;
57              
58              
59 1     1   6 use constant class_y_negative => 0;
  1         2  
  1         67  
60 1     1   6 use constant n_frac_discontinuity => .5;
  1         2  
  1         47  
61              
62 1     1   5 use constant 1.02 _default_rule => 30;
  1         13  
  1         89  
63 1         519 use constant parameter_info_array =>
64             [ { name => 'rule',
65             display => 'Rule',
66             type => 'integer',
67             default => _default_rule(),
68             minimum => 0,
69             maximum => 255,
70             width => 3,
71             type_hint => 'cellular_rule',
72             description => 'Rule number 0 to 255, encoding how triplets 111 through 000 turn into 0 or 1 in the next row.',
73             },
74             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
75 1     1   6 ];
  1         2  
76              
77             sub turn_any_straight {
78 0     0 1 0 my ($self) = @_;
79             return (($self->{'rule'} & 0x17) == 0 # single cell only
80             || ($self->{'rule'} & 0x5F) == 0x0E # left line 2
81 0 0 0     0 || ($self->{'rule'} & 0x5F) == 0x54 # right line 2
82             ? 0 # never straight
83             : 1);
84             }
85             sub turn_any_left {
86 0     0 1 0 my ($self) = @_;
87 0 0       0 return (($self->{'rule'} & 0x17) == 0 # single cell only
88             ? 0
89             : 1);
90             }
91             sub turn_any_right {
92 0     0 1 0 my ($self) = @_;
93 0 0       0 return (($self->{'rule'} & 0x17) == 0 # single cell only
94             ? 0
95             : 1);
96             }
97              
98              
99             #------------------------------------------------------------------------------
100             # x,y range
101              
102             # rule=1 000->1 goes negative if 001->0 to keep left empty
103             # so rule&3 == 1
104             #
105             # any 001->1, rule&2 goes left initially
106              
107             sub x_negative {
108 154     154 1 342 my ($self) = @_;
109             return (($self->{'rule'} & 2)
110 154   100     852 || ($self->{'rule'} & 3) == 1);
111             }
112             sub x_maximum {
113 0     0 1 0 my ($self) = @_;
114             return (($self->{'rule'} & 0x17) == 0 # single cell only
115             || $self->{'rule'}==70 || $self->{'rule'}==198
116             || $self->{'rule'}==78
117             || $self->{'rule'}==110
118 0 0 0     0 || $self->{'rule'}==230
119             ? 0
120             : undef);
121             }
122             {
123             my @x_negative_at_n
124             = (
125             undef, 2, undef, 1, undef, 3, undef, 1, # rule=0
126             undef, 3, undef, 1, undef, 4, undef, 1, # rule=8
127             undef, 2, undef, 1, undef, 3, 1, 1, # rule=16
128             undef, 2, undef, 1, undef, 4, 1, 1, # rule=24
129             undef, 2, undef, 1, undef, 2, undef, 1, # rule=32
130             undef, 3, undef, 1, undef, 2, undef, 1, # rule=40
131             undef, 2, undef, 1, undef, 3, undef, 1, # rule=48
132             undef, undef, undef, 1, undef, 3, 1, 1, # rule=56
133             undef, 1, undef, 1, undef, 2, 1, 1, # rule=64
134             undef, 1, undef, 1, undef, 2, 1, 1, # rule=72
135             undef, 2, undef, 1, undef, 3, 1, 1, # rule=80
136             undef, 2, undef, 1, undef, 3, 1, 1, # rule=88
137             undef, 1, undef, undef, undef, 2, undef, 1, # rule=96
138             undef, 1, undef, 1, undef, 2, 1, 1, # rule=104
139             undef, 2, undef, 1, undef, 3, 1, 1, # rule=112
140             undef, 2, undef, 1, undef, 3, 1, 1, # rule=120
141             undef, 2, undef, 1, undef, 4, undef, 1, # rule=128
142             undef, 5, undef, 1, undef, 7, undef, 1, # rule=136
143             undef, 2, undef, 1, undef, 5, 1, undef, # rule=144
144             undef, 2, undef, 1, undef, 6, 1, undef, # rule=152
145             undef, 2, undef, 1, undef, 2, undef, 1, # rule=160
146             undef, 6, undef, 1, undef, 2, undef, 1, # rule=168
147             undef, 2, undef, undef, undef, 3, 1, undef, # rule=176
148             undef, 2, undef, 1, undef, 3, undef, undef, # rule=184
149             undef, 1, undef, 1, undef, 2, 1, 1, # rule=192
150             undef, 1, undef, 1, undef, 2, undef, 1, # rule=200
151             undef, 2, undef, 1, undef, 3, 1, undef, # rule=208
152             undef, 2, undef, 1, undef, 3, undef, undef, # rule=216
153             undef, 1, undef, 1, undef, 2, 1, 1, # rule=224
154             undef, 1, undef, 1, undef, 2, undef, 1, # rule=232
155             undef, 2, undef, 1, undef, 3, undef, undef, # rule=240
156             undef, 2, undef, 1, undef, 3, # rule=248
157             );
158             sub x_negative_at_n {
159 0     0 1 0 my ($self) = @_;
160 0         0 my $x_negative_at_n = $x_negative_at_n[$self->{'rule'}];
161 0 0       0 return (defined $x_negative_at_n
162             ? $self->n_start + $x_negative_at_n
163             : undef);
164             }
165             }
166              
167             sub y_maximum {
168 0     0 1 0 my ($self) = @_;
169 0 0       0 return (($self->{'rule'} & 0x17) == 0 # single cell only
170             ? 0
171             : undef);
172             }
173              
174             #------------------------------------------------------------------------------
175             # sumxy,diffxy range
176              
177 1     1   7 use constant sumxy_minimum => 0; # triangular X>=-Y so X+Y>=0
  1         2  
  1         151  
178             sub sumxy_maximum {
179 0     0 1 0 my ($self) = @_;
180 0 0       0 if (($self->{'rule'} & 0x5F) == 0x0E) { # left line 2
181 0         0 return 1;
182             }
183 0         0 return undef;
184             }
185              
186             sub diffxy_minimum {
187 0     0 1 0 my ($self) = @_;
188 0 0       0 if (($self->{'rule'} & 0x5F) == 0x54) { # right line 2
189 0         0 return -1;
190             }
191 0         0 return undef;
192             }
193 1     1   7 use constant diffxy_maximum => 0; # triangular X<=Y so X-Y<=0
  1         2  
  1         300  
194              
195             #------------------------------------------------------------------------------
196             # dx range
197              
198             sub dx_minimum {
199 0     0 1 0 my ($self) = @_;
200             return (($self->{'rule'} & 0x17) == 0 # single cell only
201             || ($self->{'rule'} & 0x5F) == 0x54 # right line 2
202             ? 0
203              
204 0 0 0     0 : ($self->{'rule'} & 0x5F) == 0x0E # left line 2
    0          
205             ? -2
206              
207             : undef);
208             }
209             {
210             # Eg. rule=25 jumps +5
211             my @dx_maximum = (
212             undef, 4, undef, 3, undef, 2, undef, 1,
213             undef, 2, undef, 2, undef, 2, 1, 2,
214             undef, 3, undef, 2, undef, 1, undef, 1,
215             undef, 5, undef, 2, 2, 2, undef, 1,
216             undef, 4, undef, 3, undef, undef, undef, 2,
217             undef, 3, undef, 2, undef, undef, 1, 2,
218             undef, 3, undef, 2, undef, 2, undef, 1,
219             undef, undef, undef, 2, undef, 4, 4, 1,
220             undef, 2, undef, 5, undef, 2, 2, 2,
221             undef, undef, undef, undef, undef, 2, 2, 2,
222             undef, 1, undef, 2, 1, 1, undef, 1,
223             undef, undef, undef, 4, 2, 2, 2, 1,
224             undef, 3, undef, undef, undef, undef, undef, 4,
225             undef, undef, undef, undef, undef, 4, undef, 4,
226             undef, 1, undef, 2, 1, 1, 4, 1,
227             undef, undef, undef, 2, undef, 4, undef, 1,
228             undef, undef, undef, 5, undef, 2, undef, undef,
229             undef, undef, undef, 3, undef, 2, 1, 3,
230             undef, 5, undef, 4, undef, undef, undef, undef,
231             undef, undef, undef, 3, 2, 2, 3, undef,
232             undef, undef, undef, 3, undef, 2, undef, 2,
233             undef, undef, undef, 3, undef, 1, 1, 2,
234             undef, 3, undef, undef, undef, 2, 2, undef,
235             undef, 2, undef, 2, 2, 1, undef, undef,
236             undef, undef, undef, undef, undef, 2, 2, 2,
237             undef, 4, undef, 2, undef, 2, undef, 2,
238             undef, 3, undef, 3, 1, 3, 3, undef,
239             undef, 2, undef, 2, undef, 2, undef, undef,
240             undef, undef, undef, 2, undef, 1, 2, 1,
241             undef, 2, undef, 2, undef, 1, undef, 1,
242             undef, 3, undef, 2, 1, 2, undef, undef,
243             undef, 2, undef, 2, undef, 1,
244             );
245             sub dx_maximum {
246 0     0 1 0 my ($self) = @_;
247 0         0 return $dx_maximum[$self->{'rule'}];
248             }
249             }
250              
251             #------------------------------------------------------------------------------
252             # dy range
253              
254             # 23, 31, 55, 63,87,95, 119, 127
255             # 0x17,0x1F,0x37,0x3F,..., 0x77,0x7F alts
256             # is rule & 0x98 = 0x17
257             # Math::PlanePath::CellularRule::Line handles the dY=+1 always lines,
258             # everything else has some row with 2 or more (except the single cell only
259             # patterns).
260 1     1   7 use constant dy_minimum => 0;
  1         2  
  1         3238  
261             sub dy_maximum {
262 0     0 1 0 my ($self) = @_;
263             # 0x1,0x9,0x
264             return (($self->{'rule'} & 0x17) == 1 # single cell only
265             || $self->{'rule'}==7 || $self->{'rule'}==21 # alternating rows
266             || $self->{'rule'}==19 # alternating rows
267 0 0 0     0 || ($self->{'rule'} & 0x97) == 0x17
268             ? 2
269             : 1);
270             }
271              
272             #------------------------------------------------------------------------------
273             # absdx
274              
275             # left 2 cell line 14,46,142,174
276             # 111 -> any, doesn't occur
277             # 110 -> 0
278             # 101 -> any, doesn't occur
279             # 100 -> 0
280             # 011 -> 1
281             # 010 -> 1
282             # 001 -> 1
283             # 000 -> 0
284             # so (rule & 0x5F) == 0x0E
285             #
286             # left 1,2 cell line 6,38,134,166
287             # 111 -> any, doesn't occur
288             # 110 -> 0
289             # 101 -> any, doesn't occur
290             # 100 -> 0
291             # 011 -> 0
292             # 010 -> 1
293             # 001 -> 1
294             # 000 -> 0
295             # so (rule & 0x5F) == 0x06
296             #
297             {
298             my @absdx_minimum = (
299             undef, 0, undef, 1, undef, 0, undef, 1,
300             undef, 0, undef, 1, undef, 0, 1, 1,
301             undef, 1, undef, 1, undef, 0, 1, 1,
302             undef, 1, undef, 0, 0, 0, 1, 1,
303             undef, 0, undef, 1, undef, 0, undef, 1,
304             undef, 0, undef, 1, undef, 0, 1, 1,
305             undef, 1, undef, 1, undef, 0, undef, 1,
306             undef, undef, undef, 1, undef, 0, 1, 1,
307             undef, 0, undef, 0, undef, 0, 1, 0,
308             undef, 1, undef, 0, undef, 0, 1, 0,
309             undef, 0, undef, 1, 0, 0, 1, 1,
310             undef, 1, undef, 1, 0, 0, 1, 1,
311             undef, 1, undef, undef, undef, 0, undef, 0,
312             undef, 1, undef, 0, undef, 0, 1, 0,
313             undef, 0, undef, 1, 0, 0, 1, 1,
314             undef, 1, undef, 1, 0, 0, 1, 1,
315             undef, 0, undef, 1, undef, 0, undef, 1,
316             undef, 0, undef, 1, undef, 0, 1, 1,
317             undef, 1, undef, 1, undef, 0, 1, undef,
318             undef, 1, undef, 1, 0, 0, 1, undef,
319             undef, 0, undef, 1, undef, 0, undef, 1,
320             undef, 0, undef, 1, undef, 0, 1, 1,
321             undef, 1, undef, undef, undef, 0, 1, undef,
322             undef, 1, undef, 1, 0, 0, undef, undef,
323             undef, 1, undef, 1, undef, 0, 1, 1,
324             undef, 1, undef, 1, undef, 0, undef, 1,
325             undef, 1, undef, 1, 0, 0, 1, undef,
326             undef, 1, undef, 1, undef, 0, undef, undef,
327             undef, 1, undef, 1, undef, 0, 1, 1,
328             undef, 1, undef, 1, undef, 0, undef, 1,
329             undef, 1, undef, 1, 0, 0, undef, undef,
330             undef, 1, undef, 1, undef, 0,
331             );
332             sub absdx_minimum {
333 0     0 1 0 my ($self) = @_;
334 0         0 return $absdx_minimum[$self->{'rule'}];
335             }
336             }
337              
338             #------------------------------------------------------------------------------
339             # dsumxy
340              
341             sub dsumxy_minimum {
342 0     0 1 0 my ($self) = @_;
343             return (($self->{'rule'} & 0x5F) == 0x54 # right line 2, const dSum=+1
344             ? 1
345 0 0       0 : ($self->{'rule'} & 0x5F) == 0x0E # left line 2
    0          
346             ? -1
347             : undef);
348             }
349             {
350             my @dsumxy_maximum = (
351             undef, 4, undef, 3, undef, 2, undef, 1,
352             undef, 3, undef, 3, undef, 2, 1, 3,
353             undef, 3, undef, 2, undef, 1, undef, 1,
354             undef, 5, undef, 2, 2, 2, undef, 1,
355             undef, 4, undef, 3, undef, undef, undef, 2,
356             undef, 4, undef, 3, undef, undef, 1, 3,
357             undef, 3, undef, 2, undef, 2, undef, 1,
358             undef, undef, undef, 2, undef, 4, 4, 1,
359             undef, 3, undef, 5, undef, 2, 2, 2,
360             undef, undef, undef, undef, undef, 2, 2, 2,
361             undef, 2, undef, 2, 1, 1, undef, 1,
362             undef, undef, undef, 4, 2, 2, 2, 1,
363             undef, 3, undef, undef, undef, undef, undef, 4,
364             undef, undef, undef, undef, undef, 4, undef, 4,
365             undef, 2, undef, 2, 1, 1, 4, 1,
366             undef, undef, undef, 2, undef, 4, undef, 1,
367             undef, undef, undef, 5, undef, 2, undef, undef,
368             undef, undef, undef, 3, undef, 2, 1, 3,
369             undef, 5, undef, 4, undef, undef, undef, undef,
370             undef, undef, undef, 3, 2, 2, 3, undef,
371             undef, undef, undef, 3, undef, 2, undef, 2,
372             undef, undef, undef, 3, undef, 1, 1, 2,
373             undef, 3, undef, undef, undef, 2, 2, undef,
374             undef, 2, undef, 2, 2, 1, undef, undef,
375             undef, undef, undef, undef, undef, 2, 2, 2,
376             undef, 4, undef, 2, undef, 2, undef, 2,
377             undef, 3, undef, 3, 1, 3, 3, undef,
378             undef, 2, undef, 2, undef, 2, undef, undef,
379             undef, undef, undef, 2, undef, 1, 2, 1,
380             undef, 2, undef, 2, undef, 1, undef, 1,
381             undef, 3, undef, 2, 1, 2, undef, undef,
382             undef, 2, undef, 2, undef, 1,
383             );
384             sub dsumxy_maximum {
385 0     0 1 0 my ($self) = @_;
386 0         0 return $dsumxy_maximum[$self->{'rule'}];
387             }
388             }
389             # sub dsumxy_maximum {
390             # my ($self) = @_;
391             # return (($self->{'rule'} & 0x5F) == 0x54 # right line 2
392             # ? 1 # is constant dSum=+1
393             # : ($self->{'rule'} & 0x5F) == 0x0E # left line 2
394             # ? 1
395             # : $self->{'rule'}==3 || $self->{'rule'}==35 ? 3
396             # : $self->{'rule'} == 5 ? 2
397             # : $self->{'rule'} == 7 ? 1
398             # : $self->{'rule'} == 9 ? 3
399             # : $self->{'rule'}==11 || $self->{'rule'}==43 ? 3
400             # : $self->{'rule'} == 13 ? 2
401             # : $self->{'rule'} == 15 ? 3
402             # : $self->{'rule'}==17 || $self->{'rule'}==49 ? 3
403             # : $self->{'rule'}==19 ? 2
404             # : $self->{'rule'}==21 ? 1
405             # : ($self->{'rule'} & 0x97) == 0x17 # 0x17,...,0x7F
406             # ? 1
407             # : $self->{'rule'}==27 ? 2
408             # : $self->{'rule'}==28 || $self->{'rule'}==156 ? 2
409             # : $self->{'rule'}==29 ? 2
410             # : $self->{'rule'}==31 ? 1
411             # : $self->{'rule'}==39 ? 2
412             # : $self->{'rule'}==47 ? 3
413             # : $self->{'rule'}==51 ? 2
414             # : $self->{'rule'}==53 ? 2
415             # : $self->{'rule'}==59 ? 2
416             # : $self->{'rule'}==65 ? 3
417             # : $self->{'rule'}==69 ? 2
418             # : $self->{'rule'}==70 || $self->{'rule'}==198 ? 2
419             # : $self->{'rule'}==71 ? 2
420             # : $self->{'rule'}==77 ? 2
421             # : $self->{'rule'}==78 ? 2
422             # : $self->{'rule'}==79 ? 2
423             # : $self->{'rule'}==81 || $self->{'rule'}==113 ? 2
424             # : undef);
425             # }
426              
427             #------------------------------------------------------------------------------
428             # ddiffxy range
429              
430             sub ddiffxy_minimum {
431 0     0 1 0 my ($self) = @_;
432             return (($self->{'rule'} & 0x5F) == 0x54 # right line 2, dDiffXY=-1 or +1
433             ? -1
434 0 0       0 : ($self->{'rule'} & 0x5F) == 0x0E # left line 2, dDiffXY=-3 or +1
    0          
435             ? -3
436             : undef);
437             }
438             {
439             my @ddiffxy_maximum = (
440             undef, 4, undef, 3, undef, 2, undef, 1,
441             undef, 2, undef, 1, undef, 2, 1, 1,
442             undef, 3, undef, 2, undef, 1, undef, 1,
443             undef, 5, undef, 2, 2, 2, undef, 1,
444             undef, 4, undef, 3, undef, undef, undef, 2,
445             undef, 3, undef, 1, undef, undef, 1, 1,
446             undef, 3, undef, 2, undef, 2, undef, 1,
447             undef, undef, undef, 2, undef, 4, 4, 1,
448             undef, 2, undef, 5, undef, 2, 2, 2,
449             undef, undef, undef, undef, undef, 2, 2, 2,
450             undef, 1, undef, 2, 1, 1, undef, 1,
451             undef, undef, undef, 4, 2, 2, 2, 1,
452             undef, 3, undef, undef, undef, undef, undef, 4,
453             undef, undef, undef, undef, undef, 4, undef, 4,
454             undef, 1, undef, 2, 1, 1, 4, 1,
455             undef, undef, undef, 2, undef, 4, undef, 1,
456             undef, undef, undef, 5, undef, 2, undef, undef,
457             undef, undef, undef, 3, undef, 2, 1, 3,
458             undef, 5, undef, 4, undef, undef, undef, undef,
459             undef, undef, undef, 3, 2, 2, 3, undef,
460             undef, undef, undef, 3, undef, 2, undef, 2,
461             undef, undef, undef, 3, undef, 1, 1, 2,
462             undef, 3, undef, undef, undef, 2, 2, undef,
463             undef, 2, undef, 2, 2, 1, undef, undef,
464             undef, undef, undef, undef, undef, 2, 2, 2,
465             undef, 4, undef, 2, undef, 2, undef, 2,
466             undef, 3, undef, 3, 1, 3, 3, undef,
467             undef, 2, undef, 2, undef, 2, undef, undef,
468             undef, undef, undef, 2, undef, 1, 2, 1,
469             undef, 2, undef, 2, undef, 1, undef, 1,
470             undef, 3, undef, 2, 1, 2, undef, undef,
471             undef, 2, undef, 2, undef, 1,
472             );
473             sub ddiffxy_maximum {
474 0     0 1 0 my ($self) = @_;
475 0         0 return $ddiffxy_maximum[$self->{'rule'}];
476             }
477             }
478             # sub ddiffxy_maximum {
479             # my ($self) = @_;
480             # return (($self->{'rule'} & 0x5F) == 0x0E # left line 2
481             # ? 1
482             # : $self->{'rule'}==3 || $self->{'rule'}==35 ? 3
483             # : $self->{'rule'} == 5 ? 2
484             # : $self->{'rule'} == 7 ? 1
485             # : $self->{'rule'} == 9 ? 2
486             # : $self->{'rule'}==11 || $self->{'rule'}==43 ? 1
487             # : $self->{'rule'} == 13 ? 2
488             # : $self->{'rule'} == 15 ? 1
489             # : $self->{'rule'}==17 || $self->{'rule'}==49 ? 3
490             # : $self->{'rule'}==19 ? 2
491             # : $self->{'rule'}==21 ? 1
492             # : ($self->{'rule'} & 0x97) == 0x17 # 0x17=23,...,0x7F
493             # ? 1
494             # : $self->{'rule'}==27 ? 2
495             # : $self->{'rule'}==28 || $self->{'rule'}==156 ? 2
496             # : $self->{'rule'}==29 ? 2
497             # : $self->{'rule'}==31 ? 1
498             # : $self->{'rule'}==39 ? 2
499             # : $self->{'rule'}==41 ? 3
500             # : $self->{'rule'}==47 ? 1
501             # : $self->{'rule'}==51 ? 2
502             # : $self->{'rule'}==53 ? 2
503             # : $self->{'rule'}==55 ? 1
504             # : $self->{'rule'}==59 ? 2
505             # : $self->{'rule'}==65 ? 2
506             # : $self->{'rule'}==69 ? 2
507             # : $self->{'rule'}==70 || $self->{'rule'}==198 ? 2
508             # : $self->{'rule'}==71 ? 2
509             # : $self->{'rule'}==77 ? 2
510             # : $self->{'rule'}==78 ? 2
511             # : $self->{'rule'}==79 ? 2
512             # : $self->{'rule'}==81 || $self->{'rule'}==113 ? 1
513             # : undef);
514             # }
515              
516             #------------------------------------------------------------------------------
517             # dir range
518              
519             sub dir_maximum_dxdy {
520 0     0 1 0 my ($self) = @_;
521             return (($self->{'rule'} & 0x5F) == 0x54 # right line 2
522             ? (0,1) # north
523              
524 0 0       0 : ($self->{'rule'} & 0x5F) == 0x0E # left line 2
    0          
525             ? (-2,1)
526              
527             : (-1,0)); # supremum, west and 1 up
528             }
529              
530              
531             #------------------------------------------------------------------------------
532              
533             # cf 60 is right half Sierpinski
534             # 129 is inverse Sierpinski, except for initial N=1 cell
535             # 119 etc alternate rows PyramidRows step=4 with 2*Y
536             # 50 PyramidRows with 2*N
537             #
538             my @rule_to_class;
539             {
540             my $store = sub {
541             my ($rule, $aref) = @_;
542             if ($rule_to_class[$rule] && $rule_to_class[$rule] != $aref) {
543             die "Oops, already have rule_to_class[] $rule";
544             }
545             $rule_to_class[$rule] = $aref;
546             };
547              
548             $store->(54, [ 'Math::PlanePath::CellularRule54' ]);
549             $store->(57, [ 'Math::PlanePath::CellularRule57' ]);
550             $store->(99, [ 'Math::PlanePath::CellularRule57', mirror => 1 ]);
551             $store->(190, [ 'Math::PlanePath::CellularRule190' ]);
552             $store->(246, [ 'Math::PlanePath::CellularRule190', mirror => 1 ]);
553              
554             {
555             # ************* whole solid
556             # ***********
557             # *********
558             # *******
559             # *****
560             # ***
561             # *
562             # 0xDE and 0xFE = 222, 254
563             # 111 -> 1 solid
564             # 110 -> 1 right side
565             # 101 any, doesn't occur
566             # 100 -> 1 initial
567             # 011 -> 1 left side
568             # 010 -> 1 initial
569             # 001 -> 1 initial
570             # 000 -> 0 sides blank
571             #
572             # -*************- whole solid with full sides
573             # --***********--
574             # ---*********---
575             # ----*******----
576             # -----*****-----
577             # ------***------
578             # *
579             # and with sides
580             # 111 -> 1 solid middle
581             # 110 any, doesn't occur
582             # 101 any, doesn't occur
583             # 100 -> 1 initial
584             # 011 any, doesn't occur
585             # 010 -> 1 initial
586             # 001 -> 1 initial
587             # 000 -> 1 sides blank
588              
589             my $solid = [ 'Math::PlanePath::PyramidRows', step => 2 ];
590             $store->(222, $solid);
591             $store->(254, $solid);
592             foreach my $i (0 .. 255) {
593             $store->(($i&0x68)|0x97, $solid);
594             }
595             }
596             {
597             # ******* right half solid
598             # ******
599             # *****
600             # ****
601             # ***
602             # **
603             # *
604             # 111 -> 1 solid
605             # 110 -> 1 to right
606             # 101 any, doesn't occur
607             # 100 -> 1 initial
608             # 011 -> 1 vertical
609             # 010 -> 1 initial
610             # 001 -> 0 not to left
611             # 000 -> 0
612             my $solid_half = [ 'Math::PlanePath::PyramidRows', step => 1 ];
613             $store->(220, $solid_half);
614             $store->(252, $solid_half);
615             }
616             {
617             # * * * * * * * *
618             # * * * *
619             # * * * *
620             # * *
621             # * * * *
622             # * *
623             # * *
624             # *
625             # 18,26,82,90,146,154,210,218
626             # 111 any, doesn't occur
627             # 110 any, doesn't occur
628             # 101 -> 0
629             # 100 -> 1 initial
630             # 011 any, doesn't occur
631             # 010 -> 0 initial
632             # 001 -> 1 initial
633             # 000 -> 0 for outsides
634             #
635             my $sierpinski_triangle = [ 'Math::PlanePath::SierpinskiTriangle',
636             n_start => 1 ];
637             foreach my $i (0 .. 255) {
638             $store->(($i&0xC8)|0x12, $sierpinski_triangle);
639             }
640             }
641             $store->(60, [ 'Math::PlanePath::SierpinskiTriangle',
642             n_start => 1, align => "right" ]);
643             $store->(102, [ 'Math::PlanePath::SierpinskiTriangle',
644             n_start => 1, align => "left" ]);
645              
646             {
647             # left negative line, rule=2,10,...
648             # 111 any, doesn't occur
649             # 110 any, doesn't occur
650             # 101 any, doesn't occur
651             # 100 -> 0 initial
652             # 011 any, doesn't occur
653             # 010 -> 0 initial
654             # 001 -> 1 initial towards left
655             # 000 -> 0 for outsides
656             #
657             my $left_line = [ 'Math::PlanePath::CellularRule::Line',
658             align => 'left' ];
659             foreach my $i (0 .. 255) {
660             $store->(($i&0xE8)|0x02, $left_line);
661             }
662             }
663             {
664             # right positive line, rule=16,...
665             # 111 any, doesn't occur
666             # 110 any, doesn't occur
667             # 101 any, doesn't occur
668             # 100 -> 1 initial
669             # 011 any, doesn't occur
670             # 010 -> 0 initial
671             # 001 -> 0 initial towards left
672             # 000 -> 0 for outsides
673             #
674             my $right_line = [ 'Math::PlanePath::CellularRule::Line',
675             align => 'right' ];
676             foreach my $i (0 .. 255) {
677             $store->(($i&0xE8)|0x10, $right_line);
678             }
679             }
680             {
681             # central vertical line 4,...
682             # 111 any
683             # 110 any
684             # 101 any
685             # 100 -> 0
686             # 011 any
687             # 010 -> 1 initial cell
688             # 001 -> 0
689             # 000 -> 0
690             my $centre_line = [ 'Math::PlanePath::CellularRule::Line',
691             align => 'centre' ];
692             foreach my $i (0 .. 255) {
693             $store->(($i&0xE8)|0x04, $centre_line);
694             }
695             }
696              
697             {
698             # 1,2 alternating line left rule=6,38,134,166
699             # 111 any, doesn't occur
700             # 110 -> 0
701             # 101 any, doesn't occur
702             # 100 -> 0 initial
703             # 011 -> 0
704             # 010 -> 1 initial
705             # 001 -> 1 angle towards left
706             # 000 -> 0 for outsides
707             #
708             my $left_onetwo = [ 'Math::PlanePath::CellularRule::OneTwo',
709             align => 'left' ];
710             foreach my $i (0 .. 255) {
711             $store->(($i&0xA0)|0x06, $left_onetwo);
712             }
713             }
714             {
715             # 1,2 alternating line right rule=20,52,148,180 = 0x14,34,94,B4
716             # 111 any, doesn't occur
717             # 110 -> 0
718             # 101 any, doesn't occur
719             # 100 -> 1 angle towards right
720             # 011 -> 0
721             # 010 -> 1 vertical
722             # 001 -> 0 not to left
723             # 000 -> 0 for outsides
724             # so (rule & 0x5F) == 0x14
725             #
726             my $right_onetwo = [ 'Math::PlanePath::CellularRule::OneTwo',
727             align => 'right' ];
728             foreach my $i (0 .. 255) {
729             $store->(($i&0xA0)|0x14, $right_onetwo);
730             }
731             }
732              
733             {
734             # left line 2 rule=14,46,142,174
735             # 111 any, doesn't occur
736             # 110 -> 0
737             # 101 any, doesn't occur
738             # 100 -> 0 initial
739             # 011 -> 1
740             # 010 -> 1 initial
741             # 001 -> 1 angle towards left
742             # 000 -> 0 for outsides
743             #
744             my $left_onetwo = [ 'Math::PlanePath::CellularRule::Two',
745             align => 'left' ];
746             foreach my $i (0 .. 255) {
747             $store->(($i&0xA0)|0x0E, $left_onetwo);
748             }
749             }
750             {
751             # right line 2 rule=84,116,212,244
752             # 111 any, doesn't occur
753             # 110 -> 1
754             # 101 any, doesn't occur
755             # 100 -> 1 right, including initial
756             # 011 -> 0
757             # 010 -> 1 initial vertical
758             # 001 -> 0 not to left
759             # 000 -> 0 for outsides
760             # so (rule & 0x5F) == 0x54
761             #
762             my $right_onetwo = [ 'Math::PlanePath::CellularRule::Two',
763             align => 'right' ];
764             foreach my $i (0 .. 255) {
765             $store->(($i&0xA0)|0x54, $right_onetwo);
766             }
767             }
768              
769             {
770             # solid every second cell, 50,58,114,122,178,186,242,250, 179
771             # http://mathworld.wolfram.com/Rule250.html
772             # 111 any, doesn't occur
773             # 110 any, doesn't occur
774             # 101 -> 1 middle
775             # 100 -> 1 initial
776             # 011 any, doesn't occur
777             # 010 -> 0 initial
778             # 001 -> 1 initial
779             # 000 -> 0 outsides
780             #
781             my $odd_solid = [ 'Math::PlanePath::CellularRule::OddSolid' ];
782             foreach my $i (0 .. 255) {
783             $store->(($i&0xC8)|0x32, $odd_solid);
784             }
785             $store->(179, $odd_solid);
786             }
787             {
788             # ******* left half solid 206,238 = 0xCE,0xEE
789             # ******
790             # *****
791             # ****
792             # ***
793             # **
794             # *
795             # 111 -> 1 middle
796             # 110 -> 1 vertical
797             # 101 any, doesn't occur
798             # 100 -> 0 initial
799             # 011 -> 1 left
800             # 010 -> 1 initial
801             # 001 -> 1 initial
802             # 000 -> 0 outsides
803             my $left_solid = [ 'Math::PlanePath::PyramidRows',
804             step => 1, align => 'left' ];
805             foreach my $i (0 .. 255) {
806             $store->(($i&0x20)|0xCE, $left_solid);
807             }
808             }
809             }
810              
811             ### rule_to_class count: do { my @k = grep {defined} @rule_to_class; scalar(@k) }
812             ### rule_to_class: [ map {defined($_) && join(',',@$_)} @rule_to_class ]
813              
814             # ### zap %rule_to_class for testing ...
815             # %rule_to_class = ();
816              
817              
818             sub new {
819             ### CellularRule new() ...
820 364     364 1 50979 my $self = shift->SUPER::new(@_);
821              
822 364         852 my $rule = $self->{'rule'};
823 364 100       917 if (! defined $rule) {
824 1         3 $rule = $self->{'rule'} = _default_rule();
825             }
826             ### $rule
827              
828 364         730 my $n_start = $self->{'n_start'};
829 364 50       715 if (! defined $n_start) {
830 364         1140 $n_start = $self->{'n_start'} = $self->default_n_start;
831             }
832              
833 364 100       827 unless ($self->{'use_bitwise'}) { # secret undocumented option
834 262 100       739 if (my $aref = $rule_to_class[$rule]) {
835 107         342 my ($class, @args) = @$aref;
836             ### $class
837             ### @args
838 107 50 66     1665 $class->can('new')
839             or eval "require $class; 1"
840             or die;
841 107         444 return $class->new (rule => $rule,
842             n_start => $n_start,
843             @args);
844             }
845             }
846              
847 257         768 $self->{'rows'} = [ "\001" ];
848 257         611 $self->{'row_end_n'} = [ $n_start ];
849 257         566 $self->{'left'} = 0;
850 257         505 $self->{'right'} = 0;
851 257         608 $self->{'rule_table'} = [ map { ($rule >> $_) & 1 } 0 .. 7 ];
  2056         3862  
852              
853             ### $self
854 257         660 return $self;
855             }
856              
857             #
858             # Y=2 L 0 1 2 3 4 R right=2*Y+2
859             # Y=1 L 0 1 2 R
860             # Y=0 L 0 R
861              
862             sub _extend {
863 2028     2028   3210 my ($self) = @_;
864             ### _extend()
865              
866 2028         3029 my $rule_table = $self->{'rule_table'};
867 2028         2723 my $rows = $self->{'rows'};
868 2028         2930 my $row = $rows->[-1];
869 2028         2756 my $newrow = '';
870 2028         2825 my $rownum = $#$rows;
871 2028         2771 my $count = 0;
872 2028         3225 my $bits = $self->{'left'} * 7;
873 2028         3091 $self->{'left'} = $rule_table->[$bits];
874              
875             ### $row
876             ### $rownum
877              
878 2028         3801 foreach my $i (0 .. 2*$rownum) {
879 30616         45180 $bits = (($bits<<1) + vec($row,$i,1)) & 7;
880              
881             ### $i
882             ### $bits
883             ### new: $rule_table->[$bits]
884 30616         65426 $count +=
885             (vec($newrow,$i,1) = $rule_table->[$bits]);
886             }
887              
888 2028         3112 my $rbit = $self->{'right'};
889 2028         3097 $self->{'right'} = $rule_table->[7*$rbit];
890             ### $rbit
891             ### new right: $self->{'right'}
892              
893             # right, second last
894 2028         3042 $bits = (($bits<<1) + $rbit) & 7;
895 2028         4184 $count +=
896             (vec($newrow,2*$rownum+1,1) = $rule_table->[$bits]);
897             ### $bits
898             ### new second last: $rule_table->[$bits]
899              
900             # right end
901 2028         3413 $bits = (($bits<<1) + $rbit) & 7;
902 2028         3951 $count +=
903             (vec($newrow,2*$rownum+2,1) = $rule_table->[$bits]);
904             ### $bits
905             ### new right end: $rule_table->[$bits]
906              
907             ### $count
908             ### $newrow
909 2028         4638 push @$rows, $newrow;
910              
911 2028         2959 my $row_end_n = $self->{'row_end_n'};
912 2028         5322 push @$row_end_n, $row_end_n->[-1] + $count;
913             }
914              
915             sub n_to_xy {
916 2985     2985 1 10000 my ($self, $n) = @_;
917             ### CellularRule n_to_xy(): $n
918              
919 2985         4203 my $int = int($n);
920 2985         3888 $n -= $int; # now fraction part
921 2985 50       5463 if (2*$n >= 1) {
922 0         0 $n -= 1;
923 0         0 $int += 1;
924             }
925             # -0.5 <= $n < 0.5 fractional part
926             ### assert: 2*$n >= -1 || $n+1==$n || $n!=$n
927             ### assert: 2*$n < 1 || $n+1==$n || $n!=$n
928              
929 2985 100       5376 if ($int < $self->{'n_start'}) {
930 306         600 return;
931             }
932 2679 50       5156 if (is_infinite($int)) { return ($int,$int); }
  0         0  
933              
934 2679         4703 my $row_end_n = $self->{'row_end_n'};
935 2679         3514 my $y = 0;
936 2679         3606 for (;;) {
937 18096 100 100     49251 if (scalar(@$row_end_n) >= 3
      100        
938             && $row_end_n->[-1] == $row_end_n->[-2]
939             && $row_end_n->[-2] == $row_end_n->[-3]) {
940             ### no more cells in three rows means rest is blank ...
941 16         50 return;
942             }
943 18080 100       32189 if ($y > $#$row_end_n) {
944 498         962 _extend($self);
945             }
946 18080 100       31646 if ($int <= $row_end_n->[$y]) {
947 2663         3963 last;
948             }
949 15417         19042 $y++;
950             }
951              
952             ### $y
953             ### row_end_n: $row_end_n->[$y]
954             ### remainder: $int - $row_end_n->[$y]
955              
956 2663         3692 $int -= $row_end_n->[$y];
957 2663         4164 my $row = $self->{'rows'}->[$y];
958 2663         3989 my $x = 2*$y+1; # for first vec 2*Y
959             ### $row
960              
961 2663         5407 for ($x = 2*$y+1; $x >= 0; $x--) {
962 20264 100       41046 if (vec($row,$x,1)) {
963             ### step bit: "x=$x"
964 5136 100       9437 if (++$int > 0) {
965 2663         3604 last;
966             }
967             }
968             }
969              
970             ### result: ($n + $x - $y).",$y"
971              
972 2663         6393 return ($n + $x - $y,
973             $y);
974             }
975              
976             sub xy_to_n {
977 50592     50592 1 152073 my ($self, $x, $y) = @_;
978             ### CellularRule xy_to_n(): "$x, $y"
979              
980 50592         90999 $x = round_nearest ($x);
981 50592         93999 $y = round_nearest ($y);
982              
983 50592 50       90417 if (is_infinite($x)) { return $x; }
  0         0  
984 50592 50       99619 if (is_infinite($y)) { return $y; }
  0         0  
985              
986 50592 100 100     195848 if ($y < 0 || ! ($x <= $y && ($x+=$y) >= 0)) {
      66        
987 24480         47581 return undef;
988             }
989              
990 26112         40830 my $row_end_n = $self->{'row_end_n'};
991 26112         53537 while ($y > $#$row_end_n) {
992 1530 50 66     4826 if (scalar(@$row_end_n) >= 3
      33        
993             && $row_end_n->[-1] == $row_end_n->[-2]
994             && $row_end_n->[-2] == $row_end_n->[-3]) {
995             ### no more cells in three rows means rest is blank ...
996 0         0 return undef;
997             }
998 1530         2584 _extend($self);
999             }
1000              
1001 26112         45568 my $row = $self->{'rows'}->[$y];
1002 26112 100       49417 if (! vec($row,$x,1)) {
1003 18966         37247 return undef;
1004             }
1005 7146         9637 my $n = $row_end_n->[$y];
1006 7146         15675 foreach my $i ($x+1 .. 2*$y) {
1007 69056         94065 $n -= vec($row,$i,1);
1008             }
1009 7146         13312 return $n;
1010             }
1011              
1012             # not exact
1013             sub rect_to_n_range {
1014 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
1015             ### CellularRule rect_to_n_range(): "$x1,$y1 $x2,$y2"
1016              
1017 0 0       0 ($x1,$y1, $x2,$y2) = _rect_for_V ($x1,$y1, $x2,$y2)
1018             or return (1,0); # rect outside pyramid
1019              
1020 0 0       0 if (is_infinite($y1)) { return ($self->{'n_start'}, $y1); } # for nan
  0         0  
1021 0 0       0 if (is_infinite($y2)) { return ($self->{'n_start'}, $y2); } # for nan or inf
  0         0  
1022              
1023 0         0 my $row_end_n = $self->{'row_end_n'};
1024 0         0 while ($#$row_end_n < $y2) {
1025 0 0 0     0 if (scalar(@$row_end_n) >= 3
      0        
1026             && $row_end_n->[-1] == $row_end_n->[-2]
1027             && $row_end_n->[-2] == $row_end_n->[-3]) {
1028             ### rect_to_n_range() no more cells in three rows means rest is blank ...
1029 0         0 last;
1030             }
1031 0         0 _extend($self);
1032             }
1033              
1034 0         0 $y1 -= 1; # to be 1 past end of prev row
1035 0 0       0 if ($y1 > $#$row_end_n) { $y1 = $#$row_end_n; }
  0         0  
1036              
1037 0 0       0 if ($y2 > $#$row_end_n) { $y2 = $#$row_end_n; }
  0         0  
1038             ### y range: "$y1 to $y2"
1039              
1040             return ($y1 < 0
1041 0 0       0 ? $self->{'n_start'}
1042             : $row_end_n->[$y1] + 1,
1043              
1044             $row_end_n->[$y2]);
1045             }
1046              
1047             #------------------------------------------------------------------------------
1048              
1049             # 000,001,010,100 = 0,1,2,4 used always
1050             # if 000=1 then 111 used
1051              
1052             sub _UNDOCUMENTED__rule_is_finite {
1053 0     0   0 my ($class, $rule) = @_;
1054             # zeros 1,0,0 -> bit4 # total 16 finites
1055             # 0,1,0 -> bit2
1056             # 0,0,1 -> bit1
1057             # 0,0,0 -> bit0
1058 0         0 return ($rule & ((1<<4)|(1<<2)|(1<<1)|(1<<0))) == 0;
1059             }
1060              
1061             sub _any_101 {
1062 0     0   0 my ($rule) = @_;
1063             # or 0,0,0 -> bit0 1 & 111 == 011
1064             # 0,1,0 -> bit2 0
1065             # 0,0,1 -> bit1 1
1066             # or 0,0,0 -> bit0 1 & 111 == 011
1067             # 0,1,0 -> bit2 0
1068             # 1,0,0 -> bit4 1
1069 0   0     0 return ($rule & 1) || ($rule & 0x16) == 0x16;
1070             }
1071             sub _any_110 {
1072 0     0   0 my ($rule) = @_;
1073             }
1074             sub _any_011 {
1075 0     0   0 my ($rule) = @_;
1076             }
1077             sub _any_111 {
1078 0     0   0 my ($rule) = @_;
1079 0   0     0 return ($rule & 1) || ($rule & 0x16) == 0x16;
1080             }
1081              
1082             # $bool = Math::PlanePath::CellularRule->_NOTWORKING__rules_are_equiv($rule)
1083             sub _NOTWORKING__rules_are_equiv {
1084 0     0   0 my ($class, $a,$b) = @_;
1085              
1086 0         0 my $a_low = $a & 0x17;
1087              
1088             # same 1,0,0 -> bit4 # 00010111 = 0x17
1089             # 0,1,0 -> bit2
1090             # 0,0,1 -> bit1
1091             # 0,0,0 -> bit0
1092 0 0       0 return 0 unless $a_low == ($b & 0x17);
1093              
1094             # if 1,0,0 -> bit4 1 # & 00010111 = 10010
1095             # 0,1,0 -> bit2 0
1096             # 0,0,1 -> bit1 1
1097             # 0,0,0 -> bit0 any
1098             # or 1,0,0 -> bit4 0 # & 00010111 = 00101
1099             # 0,1,0 -> bit2 1
1100             # 0,0,1 -> bit1 any
1101             # 0,0,0 -> bit0 1
1102             # or 1,0,0 -> bit4 any # & 00010111 = 00101
1103             # 0,1,0 -> bit2 1
1104             # 0,0,1 -> bit1 0
1105             # 0,0,0 -> bit0 1
1106             # then
1107             # same 1,0,1 -> bit5 # 01001000 = 0x48
1108 0 0 0     0 if ($a_low == 0x12 || $a_low == 5) {
1109 0 0       0 return 0 unless ($a & (1<<5)) == ($b & (1<<5));
1110             }
1111              
1112 0         0 return 1;
1113             }
1114              
1115             # $bool = Math::PlanePath::CellularRule->rule_is_symmetric($rule)
1116             sub _NOTWORKING__rule_is_symmetric {
1117 0     0   0 my ($class, $rule) = @_;
1118 0   0     0 return ($class->_UNDOCUMENTED__rule_is_finite($rule) # single cell
1119             ||
1120             # same 1,1,0 -> bit6 # if it is ever reached
1121             # 0,1,1 -> bit3
1122             (($rule & (1<<6)) >> 3) == ($rule & (1<<3))
1123             &&
1124             # same 1,0,0 -> bit4 # if it is ever reached
1125             # 0,0,1 -> bit1
1126             (($rule & (1<<4)) >> 3) == ($rule & (1<<1)));
1127             }
1128              
1129             # =item C<$mirror_rule = Math::PlanePath::CellularRule-Erule_to_mirror ($rule)>
1130             #
1131             # Return a rule number which is a horizontal mirror image of C<$rule>. This
1132             # is a swap of bits 3E-E6 and 1E-E4.
1133             #
1134             # If the pattern is already symmetric then the returned C<$mirror_rule> will
1135             # generate the same pattern, though its value might be different. This
1136             # occurs if some bits in the rule value never occur and so don't affect the
1137             # result.
1138             #
1139             sub _UNDOCUMENTED__rule_to_mirror {
1140 0     0   0 my ($class, $rule) = @_;
1141              
1142             # 7,6,5,4,3,2,1,0
1143             # 1 0 1 0 0 1 0 1 = 0xA5
1144 0         0 return (($rule & 0xA5)
1145              
1146             # swap 1,1,0 -> bit6
1147             # 0,1,1 -> bit3
1148             | (($rule & (1<<6)) >> 3)
1149             | (($rule & (1<<3)) << 3)
1150              
1151             # swap 1,0,0 -> bit4
1152             # 0,0,1 -> bit1
1153             | (($rule & (1<<4)) >> 3)
1154             | (($rule & (1<<1)) << 3)
1155             );
1156             }
1157              
1158              
1159              
1160             #------------------------------------------------------------------------------
1161             {
1162             package Math::PlanePath::CellularRule::Line;
1163 1     1   8 use strict;
  1         2  
  1         33  
1164 1     1   6 use Carp 'croak';
  1         2  
  1         45  
1165 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         63  
1166             $VERSION = 129;
1167 1     1   6 use Math::PlanePath;
  1         2  
  1         48  
1168             @ISA = ('Math::PlanePath');
1169              
1170             use Math::PlanePath::Base::Generic
1171 1         73 'is_infinite',
1172 1     1   6 'round_nearest';
  1         2  
1173              
1174 1         56 use constant parameter_info_array =>
1175             [ { name => 'align',
1176             display => 'Align',
1177             type => 'enum',
1178             default => 'left',
1179             choices => ['left','centre','right'],
1180             },
1181             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
1182 1     1   6 ];
  1         2  
1183              
1184 1     1   5 use constant class_y_negative => 0;
  1         2  
  1         63  
1185 1     1   6 use constant n_frac_discontinuity => .5;
  1         2  
  1         177  
1186              
1187             sub x_negative {
1188 48     48   134 my ($self) = @_;
1189 48         167 return ($self->{'align'} eq 'left');
1190             }
1191             sub x_maximum {
1192 0     0   0 my ($self) = @_;
1193 0 0       0 return ($self->{'align'} eq 'right'
1194             ? undef
1195             : 0);
1196             }
1197             sub x_negative_at_n {
1198 0     0   0 my ($self) = @_;
1199 0 0       0 return ($self->{'align'} eq 'left' ? $self->n_start + 1 : undef);
1200             }
1201              
1202 1     1   6 use constant sumxy_minimum => 0; # triangular X>=-Y so X+Y>=0
  1         2  
  1         159  
1203              
1204             sub sumxy_maximum {
1205 0     0   0 my ($self) = @_;
1206 0 0       0 return ($self->{'align'} eq 'left'
1207             ? 0 # left X=-Y so X+Y=0 always
1208             : undef);
1209             }
1210              
1211             sub diffxy_minimum {
1212 0     0   0 my ($self) = @_;
1213 0 0       0 return ($self->{'align'} eq 'right'
1214             ? 0 # right X=Y so X-Y=0 always
1215             : undef);
1216             }
1217 1     1   7 use constant diffxy_maximum => 0; # triangular X<=Y so X-Y<=0
  1         2  
  1         181  
1218              
1219             # always dX=sign,dY=+1 so dSumXY = sign+1
1220             sub dsumxy_minimum {
1221 0     0   0 my ($self) = @_;
1222 0         0 return $self->{'sign'}+1;
1223             }
1224             *dsumxy_maximum = \&dsumxy_minimum;
1225              
1226             # always dX=sign,dY=+1 so dDiffXY = sign-1
1227             sub ddiffxy_minimum {
1228 0     0   0 my ($self) = @_;
1229 0         0 return $self->{'sign'}-1;
1230             }
1231             *ddiffxy_maximum = \&ddiffxy_minimum;
1232              
1233             sub absdx_minimum {
1234 0     0   0 my ($self) = @_;
1235 0 0       0 return ($self->{'align'} eq 'centre' ? 0 : 1);
1236             }
1237 1     1   7 use constant absdy_minimum => 1; # dY=1 always
  1         1  
  1         131  
1238              
1239             sub dir_minimum_dxdy {
1240 0     0   0 my ($self) = @_;
1241 0         0 return ($self->dx_minimum, 1);
1242             }
1243             *dir_maximum_dxdy = \&dir_minimum_dxdy; # same direction always
1244              
1245             sub dx_minimum {
1246 0     0   0 my ($self) = @_;
1247 0         0 return $self->{'sign'};
1248             }
1249             *dx_maximum = \&dx_minimum; # same step always
1250 1     1   6 use constant dy_minimum => 1;
  1         2  
  1         59  
1251 1     1   7 use constant dy_maximum => 1;
  1         2  
  1         108  
1252             sub _UNDOCUMENTED__dxdy_list {
1253 0     0   0 my ($self) = @_;
1254 0         0 return ($self->{'sign'}, 1);
1255             }
1256             *_UNDOCUMENTED__dxdy_list_at_n = __PACKAGE__->can('n_start');
1257              
1258             # straight ahead only
1259 1     1   6 use constant turn_any_left => 0;
  1         2  
  1         56  
1260 1     1   6 use constant turn_any_right => 0;
  1         2  
  1         787  
1261              
1262              
1263             #-----------------------------------------------------------
1264             my %align_to_sign = (left => -1,
1265             centre => 0,
1266             right => 1);
1267             sub new {
1268 48     48   176 my $self = shift->SUPER::new (@_);
1269 48 50       166 if (! defined $self->{'n_start'}) {
1270 0         0 $self->{'n_start'} = $self->default_n_start;
1271             }
1272 48   50     173 $self->{'align'} ||= 'left';
1273 48         177 $self->{'sign'} = $align_to_sign{$self->{'align'}};
1274 48 50       140 if (! defined $self->{'sign'}) {
1275 0         0 croak "Unrecognised align parameter: ",$self->{'align'};
1276             }
1277 48         192 return $self;
1278             }
1279              
1280             sub n_to_xy {
1281 2704     2704   15963 my ($self, $n) = @_;
1282             ### CellularRule-Line n_to_xy(): $n
1283              
1284 2704         3934 $n = $n - $self->{'n_start'}; # to N=0 basis
1285              
1286 2704         3927 my $int = int($n);
1287 2704         3474 $n -= $int; # now fraction part
1288 2704 50       5145 if (2*$n >= 1) {
1289 0         0 $n -= 1;
1290 0         0 $int += 1;
1291             }
1292             # -0.5 <= $n < 0.5 fractional part
1293             ### assert: 2*$n >= -1
1294             ### assert: 2*$n < 1
1295             ### $int
1296              
1297 2704 100       4454 if ($int < 0) {
1298 144         316 return;
1299             }
1300 2560 50       4767 if (is_infinite($int)) { return ($int,$int); }
  0         0  
1301              
1302 2560         6055 return ($n + $int*$self->{'sign'},
1303             $int);
1304             }
1305              
1306             sub n_to_radius {
1307 0     0   0 my ($self, $n) = @_;
1308 0         0 $n = $n - $self->{'n_start'}; # to N=0 start
1309 0 0       0 if ($n < 0) { return undef; }
  0         0  
1310 0 0       0 if ($self->{'align'} ne 'centre') {
1311 0         0 $n *= sqrt(2 + $n*0); # inherit bigfloat etc from $n
1312             }
1313 0         0 return $n;
1314             }
1315             sub n_to_rsquared {
1316 0     0   0 my ($self, $n) = @_;
1317 0         0 $n = $n - $self->{'n_start'}; # to N=0 start
1318 0 0       0 if ($n < 0) { return undef; }
  0         0  
1319 0         0 $n *= $n; # squared
1320 0 0       0 if ($self->{'align'} ne 'centre') {
1321 0         0 $n *= 2;
1322             }
1323 0         0 return $n;
1324             }
1325              
1326             sub xy_to_n {
1327 23808     23808   112812 my ($self, $x, $y) = @_;
1328             ### CellularRule-Line xy_to_n(): "$x,$y"
1329              
1330 23808         42722 $x = round_nearest ($x);
1331 23808         43900 $y = round_nearest ($y);
1332 23808 50       42697 if (is_infinite($x)) { return $x; }
  0         0  
1333              
1334 23808 100 66     73041 if ($y >= 0 && $x == $y*$self->{'sign'}) {
1335 768         1781 return $y + $self->{'n_start'};
1336             } else {
1337 23040         45558 return undef;
1338             }
1339             }
1340              
1341             # not exact
1342             sub rect_to_n_range {
1343 0     0   0 my ($self, $x1,$y1, $x2,$y2) = @_;
1344              
1345 0         0 $x1 = round_nearest ($x1);
1346 0         0 $y1 = round_nearest ($y1);
1347 0         0 $x2 = round_nearest ($x2);
1348 0         0 $y2 = round_nearest ($y2);
1349 0 0       0 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  0         0  
1350              
1351 0 0       0 if ($y2 < 0) {
1352 0         0 return (1, 0);
1353             }
1354 0 0       0 if ($y1 < 0) { $y1 *= 0; }
  0         0  
1355             return ($y1 + $self->{'n_start'},
1356 0         0 $y2 + $self->{'n_start'});
1357             }
1358             }
1359              
1360             #------------------------------------------------------------------------------
1361             {
1362             package Math::PlanePath::CellularRule::OddSolid;
1363 1     1   10 use strict;
  1         2  
  1         36  
1364 1     1   6 use vars '$VERSION', '@ISA';
  1         1  
  1         99  
1365             $VERSION = 129;
1366 1     1   8 use Math::PlanePath;
  1         2  
  1         33  
1367             @ISA = ('Math::PlanePath');
1368              
1369             use Math::PlanePath::Base::Generic
1370 1         53 'is_infinite',
1371 1     1   5 'round_nearest';
  1         1  
1372              
1373 1     1   641 use Math::PlanePath::PyramidRows;
  1         2  
  1         38  
1374              
1375 1         93 use constant parameter_info_array =>
1376             [ Math::PlanePath::Base::Generic::parameter_info_nstart1(),
1377 1     1   7 ];
  1         1  
1378 1     1   7 use constant class_y_negative => 0;
  1         1  
  1         50  
1379 1     1   6 use constant n_frac_discontinuity => .5;
  1         2  
  1         75  
1380              
1381             sub x_negative_at_n {
1382 0     0   0 my ($self) = @_;
1383 0         0 return $self->n_start + 1;
1384             }
1385 1     1   6 use constant sumxy_minimum => 0; # triangular X>=-Y so X+Y>=0
  1         3  
  1         41  
1386 1     1   6 use constant diffxy_maximum => 0; # triangular X<=Y so X-Y<=0
  1         2  
  1         53  
1387 1     1   7 use constant dx_maximum => 2;
  1         2  
  1         43  
1388 1     1   6 use constant dy_minimum => 0;
  1         5  
  1         54  
1389 1     1   6 use constant dy_maximum => 1;
  1         2  
  1         40  
1390 1     1   5 use constant absdx_minimum => 1;
  1         2  
  1         60  
1391 1     1   6 use constant dsumxy_maximum => 2; # straight E dX=+2
  1         2  
  1         57  
1392 1     1   6 use constant ddiffxy_maximum => 2; # straight E dX=+2
  1         2  
  1         46  
1393 1     1   6 use constant dir_maximum_dxdy => (-1,0); # West, supremum
  1         2  
  1         416  
1394              
1395             sub new {
1396 10     10   43 my $self = shift->SUPER::new (@_);
1397              
1398 10 50       38 if (! defined $self->{'n_start'}) {
1399 0         0 $self->{'n_start'} = $self->default_n_start;
1400             }
1401             # delegate to sub-object
1402             $self->{'pyramid'}
1403 10         63 = Math::PlanePath::PyramidRows->new (n_start => $self->{'n_start'},
1404             step => 1);
1405 10         71 return $self;
1406             }
1407             sub n_to_xy {
1408 243     243   3607 my ($self, $n) = @_;
1409             ### CellularRule-OddSolid n_to_xy(): $n
1410 243 100       535 my ($x,$y) = $self->{'pyramid'}->n_to_xy($n)
1411             or return;
1412             ### pyramid: "$x, $y"
1413 216         468 return ($x+round_nearest($x) - $y, $y);
1414             }
1415             sub xy_to_n {
1416 4470     4470   21518 my ($self, $x, $y) = @_;
1417             ### CellularRule-OddSolid xy_to_n(): "$x,$y"
1418 4470         8141 $x = round_nearest ($x);
1419 4470         8567 $y = round_nearest ($y);
1420 4470 100       8467 if (($x+$y)%2) {
1421 2232         3803 return undef;
1422             }
1423 2238         5591 return $self->{'pyramid'}->xy_to_n(($x+$y)/2, $y);
1424             }
1425              
1426             # (y2+1)*(y2+2)/2 - 1
1427             # = (y2^2 + 3*y2 + 2 - 2)/2
1428             # = y2*(y2+3)/2
1429              
1430             # not exact
1431             sub rect_to_n_range {
1432 6     6   341 my ($self, $x1,$y1, $x2,$y2) = @_;
1433             ### OddSolid rect_to_n_range() ...
1434              
1435 6         14 $y1 = round_nearest ($y1);
1436 6         13 $y2 = round_nearest ($y2);
1437              
1438 6 50       15 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  0         0  
1439 6 50       15 if ($y1 < 0) { $y1 *= 0; }
  0         0  
1440              
1441             return ($y1*($y1+1)/2 + $self->{'n_start'}, # start of row, triangular+1
1442 6         21 $y2*($y2+3)/2 + $self->{'n_start'}); # end of row, prev triangular
1443             }
1444             }
1445              
1446             #------------------------------------------------------------------------------
1447             {
1448             package Math::PlanePath::CellularRule::OneTwo;
1449 1     1   8 use strict;
  1         10  
  1         34  
1450 1     1   6 use Carp 'croak';
  1         2  
  1         65  
1451 1     1   6 use vars '$VERSION', '@ISA';
  1         2  
  1         51  
1452             $VERSION = 129;
1453 1     1   6 use Math::PlanePath;
  1         2  
  1         52  
1454             @ISA = ('Math::PlanePath');
1455             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
1456              
1457             use Math::PlanePath::Base::Generic
1458 1         80 'is_infinite',
1459 1     1   6 'round_nearest';
  1         2  
1460              
1461             # rule=6,38,134,166 sign=-1
1462             # **
1463             # *
1464             # **
1465             # *
1466             #
1467             # rule=20,52,148,180 sign=1
1468             # **
1469             # *
1470             # **
1471             # *
1472             #
1473 1         63 use constant parameter_info_array =>
1474             [ { name => 'align',
1475             display => 'Align',
1476             type => 'enum',
1477             default => 'left',
1478             choices => ['left','right'],
1479             },
1480             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
1481 1     1   15 ];
  1         2  
1482              
1483 1     1   83 use constant class_y_negative => 0;
  1         4  
  1         50  
1484 1     1   6 use constant n_frac_discontinuity => .5;
  1         2  
  1         178  
1485              
1486             sub x_negative {
1487 8     8   31 my ($self) = @_;
1488 8         39 return ($self->{'align'} eq 'left');
1489             }
1490             sub x_negative_at_n {
1491 0     0   0 my ($self) = @_;
1492 0 0       0 return ($self->{'align'} eq 'left' ? $self->n_start + 1 : undef);
1493             }
1494             sub x_maximum {
1495 0     0   0 my ($self) = @_;
1496 0 0       0 return ($self->{'align'} eq 'left'
1497             ? 0
1498             : undef);
1499             }
1500              
1501 1     1   7 use constant sumxy_minimum => 0; # triangular X>=-Y so X+Y>=0
  1         2  
  1         144  
1502             {
1503             my %sumxy_maximum = (left => 1);
1504             sub sumxy_maximum {
1505 0     0   0 my ($self) = @_;
1506 0         0 return $sumxy_maximum{$self->{'align'}};
1507             }
1508             }
1509              
1510             {
1511             my %diffxy_minimum = (right => -1);
1512             sub diffxy_minimum {
1513 0     0   0 my ($self) = @_;
1514 0         0 return $diffxy_minimum{$self->{'align'}};
1515             }
1516             }
1517 1     1   7 use constant diffxy_maximum => 0; # triangular X<=Y so X-Y<=0
  1         1  
  1         140  
1518              
1519             {
1520             my %dx_minimum = (left => -2,
1521             right => 0);
1522             sub dx_minimum {
1523 0     0   0 my ($self) = @_;
1524 0         0 return $dx_minimum{$self->{'align'}};
1525             }
1526             }
1527 1     1   7 use constant dx_maximum => 1;
  1         2  
  1         46  
1528 1     1   5 use constant dy_minimum => 0;
  1         2  
  1         50  
1529 1     1   13 use constant dy_maximum => 1;
  1         3  
  1         441  
1530             {
1531             my %_UNDOCUMENTED__dxdy_list = (left => [ 1,0, # E
1532             -1,1, # NW
1533             -2,1 ], # WNW
1534             right => [ 1,0, # E
1535             1,1, # NE
1536             0,1 ]); # N
1537             sub _UNDOCUMENTED__dxdy_list {
1538 0     0   0 my ($self) = @_;
1539 0         0 return @{$_UNDOCUMENTED__dxdy_list{$self->{'align'}}};
  0         0  
1540             }
1541             }
1542             {
1543             my %_UNDOCUMENTED__dxdy_list_at_n = (left => 2,
1544             right => 2);
1545             sub _UNDOCUMENTED__dxdy_list_at_n {
1546 0     0   0 my ($self) = @_;
1547 0         0 return $self->n_start + $_UNDOCUMENTED__dxdy_list_at_n{$self->{'align'}};
1548             }
1549             }
1550              
1551             {
1552             my %absdx_minimum = (left => 1, # -2 or +1, so minimum abs is 1
1553             right => 0); # 0 or +1, so minimum abs is 0
1554             sub absdx_minimum {
1555 0     0   0 my ($self) = @_;
1556 0         0 return $absdx_minimum{$self->{'align'}};
1557             }
1558             }
1559              
1560             sub dsumxy_minimum {
1561 0     0   0 my ($self) = @_;
1562 0         0 return $self->{'sign'};
1563             # ? -1 # left, ENE
1564             # : 1); # right, N, going as a stairstep so always increase
1565             }
1566             sub dsumxy_maximum {
1567 0     0   0 my ($self) = @_;
1568 0 0       0 return ($self->{'sign'} < 0
1569             ? 1 # left, East
1570             : 2); # right, NE diagonal
1571             }
1572              
1573             sub ddiffxy_minimum {
1574 0     0   0 my ($self) = @_;
1575 0 0       0 return ($self->{'sign'} < 0
1576             ? -3 # left, ENE
1577             : -1); # right, N, going as a stairstep so always increase
1578             }
1579             sub ddiffxy_maximum {
1580 0     0   0 my ($self) = @_;
1581 0 0       0 return ($self->{'sign'} < 0
1582             ? 1 # left, East
1583             : 1); # right, NE diagonal
1584             }
1585              
1586             sub dir_maximum_dxdy {
1587 0     0   0 my ($self) = @_;
1588 0 0       0 return ($self->{'align'} eq 'left'
1589             ? (-2,1)
1590             : (0,1)); # North
1591             }
1592              
1593 1     1   7 use constant turn_any_straight => 0; # never straight
  1         2  
  1         723  
1594              
1595              
1596             #---------------------------------------------
1597             my %align_to_sign = (left => -1,
1598             right => 1);
1599             sub new {
1600 10     10   49 my $self = shift->SUPER::new (@_);
1601 10 50       46 if (! defined $self->{'n_start'}) {
1602 0         0 $self->{'n_start'} = $self->default_n_start;
1603             }
1604 10   50     30 $self->{'align'} ||= 'left';
1605             $self->{'sign'} = $align_to_sign{$self->{'align'}}
1606 10   33     44 || croak "Unrecognised align parameter: ",$self->{'align'};
1607 10         40 return $self;
1608             }
1609              
1610             sub n_to_xy {
1611 400     400   3420 my ($self, $n) = @_;
1612             ### CellularRule-OneTwo n_to_xy(): $n
1613              
1614 400         641 $n = $n - $self->{'n_start'} + 1; # to N=1 basis, and warn if $n undef
1615              
1616 400         537 my $int = int($n);
1617 400         558 $n -= $int; # $n now fraction part
1618 400 50       716 if (2*$n >= 1) {
1619 0         0 $n -= 1;
1620             } else {
1621 400         549 $int -= 1; # to N=0 basis
1622             }
1623             # -0.5 <= $n < 0.5 fractional part
1624             ### $int
1625              
1626 400 100       731 if ($int < 0) {
1627 24         51 return;
1628             }
1629 376 50       761 if (is_infinite($int)) { return ($int,$int); }
  0         0  
1630              
1631             ### assert: 2*$n >= -1 || $n+1==$n || $n!=$n
1632             ### assert: 2*$n < 1 || $n+1==$n || $n!=$n
1633              
1634 376         874 my $x = _divrem_mutate($int,3);
1635 376         550 $int *= 2;
1636 376 100       703 if ($x) {
1637 244         364 $int += 1;
1638 244 100       442 $x += ($self->{'align'} eq 'left' ? -1 : -2);
1639             }
1640 376         836 return ($n + $x + $int*$self->{'sign'},
1641             $int);
1642             }
1643              
1644             sub xy_to_n {
1645 3980     3980   20701 my ($self, $x, $y) = @_;
1646             ### CellularRule-OneTwo xy_to_n(): "$x,$y"
1647              
1648 3980         7245 $x = round_nearest ($x);
1649 3980         7401 $y = round_nearest ($y);
1650 3980 50       7200 if ($y < 0) { return undef; }
  0         0  
1651 3980 50       7282 if (is_infinite($y)) { return $y; }
  0         0  
1652              
1653 3980         7212 $x -= $y*$self->{'sign'};
1654 3980 100       6966 if ($y % 2) {
1655             ### odd row: "x=$x y=$y"
1656 1992 100       3604 if ($self->{'sign'} > 0) { $x += 1; }
  996         1372  
1657 1992 100 100     4683 if ($x < 0 || $x > 1) { return undef; }
  1856         3687  
1658 136         389 return (3*$y-1)/2 + $x + $self->{'n_start'};
1659             } else {
1660             ### even row: "x=$x y=$y"
1661 1988 100       3600 if ($x != 0) { return undef; }
  1920         3594  
1662 68         200 return ($y/2)*3 + $self->{'n_start'};
1663             }
1664             }
1665              
1666             # not exact
1667             sub rect_to_n_range {
1668 12     12   674 my ($self, $x1,$y1, $x2,$y2) = @_;
1669              
1670 12         33 $x1 = round_nearest ($x1);
1671 12         24 $y1 = round_nearest ($y1);
1672 12         24 $x2 = round_nearest ($x2);
1673 12         24 $y2 = round_nearest ($y2);
1674 12 50       24 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  0         0  
1675 12 50       24 if ($y2 < 0) {
1676 0         0 return (1, 0);
1677             }
1678 12 50       32 if ($y1 < 0) { $y1 *= 0; }
  0         0  
1679 12 50       26 if (is_infinite($y1)) { return (1, $y1+1); }
  0         0  
1680 12 50       24 if (is_infinite($y2)) { return (1, $y2+1); }
  0         0  
1681 12         23 $y1 -= ($y1%2);
1682 12         19 $y2 += ($y2%2);
1683             return ($y1/2*3 + $self->{'n_start'},
1684 12         41 $y2/2*3 + $self->{'n_start'});
1685             }
1686             }
1687              
1688             #------------------------------------------------------------------------------
1689             {
1690             package Math::PlanePath::CellularRule::Two;
1691 1     1   7 use strict;
  1         2  
  1         34  
1692 1     1   6 use Carp 'croak';
  1         2  
  1         42  
1693 1     1   15 use vars '$VERSION', '@ISA';
  1         3  
  1         80  
1694             $VERSION = 129;
1695 1     1   8 use Math::PlanePath;
  1         1  
  1         56  
1696             @ISA = ('Math::PlanePath');
1697             *_divrem = \&Math::PlanePath::_divrem;
1698              
1699             use Math::PlanePath::Base::Generic
1700 1         77 'is_infinite',
1701 1     1   7 'round_nearest';
  1         12  
1702              
1703             # left 2 cell line rule=14,46,142,174 sign=-1
1704             # **
1705             # **
1706             # **
1707             # *
1708             #
1709             # right 2 cell line rule=84,116,212,244 sign=1
1710             # rule & 0x5F == 0x54
1711             # **
1712             # **
1713             # **
1714             # *
1715             #
1716 1         65 use constant parameter_info_array =>
1717             [ { name => 'align',
1718             display => 'Align',
1719             type => 'enum',
1720             default => 'left',
1721             choices => ['left','right'],
1722             },
1723             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
1724 1     1   6 ];
  1         2  
1725              
1726 1     1   6 use constant class_y_negative => 0;
  1         2  
  1         46  
1727 1     1   5 use constant n_frac_discontinuity => .5;
  1         2  
  1         253  
1728              
1729             sub x_negative {
1730 8     8   28 my ($self) = @_;
1731 8         37 return ($self->{'align'} eq 'left');
1732             }
1733             sub x_maximum {
1734 0     0   0 my ($self) = @_;
1735 0 0       0 return ($self->{'align'} eq 'left'
1736             ? 0
1737             : undef);
1738             }
1739             sub x_negative_at_n {
1740 0     0   0 my ($self) = @_;
1741 0 0       0 return ($self->{'align'} eq 'left' ? $self->n_start + 1 : undef);
1742             }
1743              
1744 1     1   6 use constant sumxy_minimum => 0; # triangular X>=-Y so X+Y>=0
  1         2  
  1         194  
1745             {
1746             my %sumxy_maximum = (left => 1);
1747             sub sumxy_maximum {
1748 0     0   0 my ($self) = @_;
1749 0         0 return $sumxy_maximum{$self->{'align'}};
1750             }
1751             }
1752              
1753             {
1754             my %diffxy_minimum = (right => -1);
1755             sub diffxy_minimum {
1756 0     0   0 my ($self) = @_;
1757 0         0 return $diffxy_minimum{$self->{'align'}};
1758             }
1759             }
1760 1     1   7 use constant diffxy_maximum => 0;
  1         2  
  1         111  
1761              
1762             {
1763             my %dx_minimum = (left => -2,
1764             right => 0);
1765             sub dx_minimum {
1766 0     0   0 my ($self) = @_;
1767 0         0 return $dx_minimum{$self->{'align'}};
1768             }
1769             }
1770 1     1   6 use constant dx_maximum => 1;
  1         2  
  1         58  
1771 1     1   6 use constant dy_minimum => 0;
  1         1  
  1         50  
1772 1     1   6 use constant dy_maximum => 1;
  1         1  
  1         265  
1773             {
1774             my %_UNDOCUMENTED__dxdy_list = (left => [ 1,0, # E
1775             -1,1, # NW at N=1
1776             -2,1, # WNW
1777             ],
1778             right => [ 1,0, # E
1779             0,1, # N
1780             ]);
1781             sub _UNDOCUMENTED__dxdy_list {
1782 0     0   0 my ($self) = @_;
1783 0         0 return @{$_UNDOCUMENTED__dxdy_list{$self->{'align'}}};
  0         0  
1784             }
1785             }
1786             {
1787             my %_UNDOCUMENTED__dxdy_list_at_n = (left => 2,
1788             right => 1);
1789             sub _UNDOCUMENTED__dxdy_list_at_n {
1790 0     0   0 my ($self) = @_;
1791 0         0 return $self->n_start + $_UNDOCUMENTED__dxdy_list_at_n{$self->{'align'}};
1792             }
1793             }
1794              
1795             {
1796             my %absdx_minimum = (left => 1, # -2 or +1, so minimum abs is 1
1797             right => 0); # 0 or +1, so minimum abs is 0
1798             sub absdx_minimum {
1799 0     0   0 my ($self) = @_;
1800 0         0 return $absdx_minimum{$self->{'align'}};
1801             }
1802             }
1803              
1804             # left => -1, # WNW dX=-2,dY=1
1805             # right => 1; # N or E
1806             sub dsumxy_minimum {
1807 0     0   0 my ($self) = @_;
1808 0         0 return $self->{'sign'};
1809             }
1810 1     1   6 use constant dsumxy_maximum => 1; # E for left, or N or E for right
  1         2  
  1         202  
1811              
1812             sub ddiffxy_minimum {
1813 0     0   0 my ($self) = @_;
1814 0 0       0 return ($self->{'sign'} < 0
1815             ? -3 # left, ENE
1816             : -1); # right, N, going as a stairstep so always increase
1817             }
1818             sub ddiffxy_maximum {
1819 0     0   0 my ($self) = @_;
1820 0 0       0 return ($self->{'sign'} < 0
1821             ? 1 # left, East
1822             : 1); # right, NE diagonal
1823             }
1824              
1825             sub dir_maximum_dxdy {
1826 0     0   0 my ($self) = @_;
1827 0 0       0 return ($self->{'align'} eq 'left'
1828             ? (-2,1)
1829             : (0,1)); # North
1830             }
1831              
1832 1     1   7 use constant turn_any_straight => 0; # never straight
  1         1  
  1         724  
1833              
1834              
1835             #---------------------------------------------
1836             my %align_to_sign = (left => -1,
1837             right => 1);
1838             sub new {
1839 10     10   51 my $self = shift->SUPER::new (@_);
1840 10 50       49 if (! defined $self->{'n_start'}) {
1841 0         0 $self->{'n_start'} = $self->default_n_start;
1842             }
1843 10   50     30 $self->{'align'} ||= 'left';
1844             $self->{'sign'} = $align_to_sign{$self->{'align'}}
1845 10   33     46 || croak "Unrecognised align parameter: ",$self->{'align'};
1846 10         36 return $self;
1847             }
1848              
1849             # N=-.5 X=-.5, Y=0
1850             # N=0 X=0, Y=0
1851             # N=.49 X=.49, Y=0
1852             #
1853             # N=.5 X=-.5, Y=1 2N=1 Y=(2N+3)/4
1854             # N=1 X=0, Y=1 X=
1855             # N=2 X=1, Y=1
1856             # N=2.4 X=1.4, Y=1
1857             #
1858             # N=2.5 X=-.5, Y=2 2N=5
1859             # N=3 X=0, Y=2
1860             # N=4 X=1, Y=2
1861             # N=4.4 X=1.4, Y=2
1862             #
1863             sub n_to_xy {
1864 402     402   3569 my ($self, $n) = @_;
1865             ### CellularRule-Two n_to_xy(): $n
1866              
1867 402         672 $n = 2*($n - $self->{'n_start'}); # to N=0 basis, and warn if $n undef
1868 402 100       750 if ($n < -1) { return; }
  24         53  
1869              
1870 378         721 my ($y, $x) = _divrem ($n+3, 4);
1871 378 100       687 if ($y == 0) { $x += $self->{'sign'} - 1; }
  18         45  
1872 378         907 return (($x - $self->{'sign'} - 2)/2 + $y*$self->{'sign'},
1873             $y);
1874             }
1875              
1876             sub xy_to_n {
1877 3982     3982   20417 my ($self, $x, $y) = @_;
1878             ### CellularRule-Two xy_to_n(): "$x,$y"
1879              
1880 3982         7315 $x = round_nearest ($x);
1881 3982         7363 $y = round_nearest ($y);
1882 3982 50       7046 if ($y < 0) { return undef; }
  0         0  
1883 3982 50       6840 if (is_infinite($y)) { return $y; }
  0         0  
1884              
1885 3982 100       8114 if ($self->{'align'} eq 'left') {
1886 1991         2710 $x += $y;
1887 1991 100       3259 if ($y) { $x -= 1; }
  1866         2728  
1888             } else {
1889 1991         2691 $x -= $y;
1890             }
1891 3982 100 100     10094 if ($x < ($y ? -1 : 0) || $x > 0) {
    100          
1892 3720         6946 return undef;
1893             }
1894              
1895 262         564 return 2*$y + $x + $self->{'n_start'};
1896             }
1897              
1898             # not exact
1899             sub rect_to_n_range {
1900 14     14   861 my ($self, $x1,$y1, $x2,$y2) = @_;
1901             ### CellularRule-Two rect_to_n_range() ...
1902              
1903 14         33 $x1 = round_nearest ($x1);
1904 14         62 $y1 = round_nearest ($y1);
1905 14         27 $x2 = round_nearest ($x2);
1906 14         27 $y2 = round_nearest ($y2);
1907 14 50       28 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  0         0  
1908 14 50       27 if ($y2 < 0) {
1909 0         0 return (1, 0);
1910             }
1911 14 50       22 if ($y1 < 0) { $y1 *= 0; }
  0         0  
1912             ### $y1
1913             ### $y2
1914              
1915 14 50       38 if (is_infinite($y1)) { return (1, $y1); }
  0         0  
1916 14 50       30 if (is_infinite($y2)) { return (1, $y2); }
  0         0  
1917             return (2*$y1 + $self->{'n_start'} - ($y1 == 0 ? 0 : 1),
1918 14 50       50 2*$y2 + $self->{'n_start'});
1919             }
1920             }
1921              
1922             1;
1923             __END__