File Coverage

blib/lib/Math/PlanePath/PyramidRows.pm
Criterion Covered Total %
statement 78 119 65.5
branch 22 60 36.6
condition 18 35 51.4
subroutine 16 33 48.4
pod 21 21 100.0
total 155 268 57.8


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
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             # rule=50,58,114,122,178,179,186,242,250
20             # spacing=2,step=1
21             # full V with points spaced apart
22             # math-image --path=CellularRule,rule=50 --all --text
23             #
24             # A091018, A090894 using n_start=0
25             # A196199, A000196, A053186 using n_start=0
26              
27             package Math::PlanePath::PyramidRows;
28 2     2   1296 use 5.004;
  2         9  
29 2     2   12 use strict;
  2         2  
  2         59  
30 2     2   11 use Carp 'croak';
  2         4  
  2         145  
31             #use List::Util 'min','max';
32             *min = \&Math::PlanePath::_min;
33             *max = \&Math::PlanePath::_max;
34              
35 2     2   12 use vars '$VERSION', '@ISA';
  2         4  
  2         130  
36             $VERSION = 128;
37 2     2   943 use Math::PlanePath;
  2         5  
  2         135  
38             @ISA = ('Math::PlanePath');
39             *_sqrtint = \&Math::PlanePath::_sqrtint;
40              
41             use Math::PlanePath::Base::Generic
42 2     2   13 'round_nearest';
  2         4  
  2         83  
43              
44             # uncomment this to run the ### lines
45             #use Smart::Comments;
46              
47              
48 2     2   10 use constant class_y_negative => 0;
  2         3  
  2         115  
49 2     2   12 use constant n_frac_discontinuity => .5;
  2         4  
  2         198  
50              
51 2         1048 use constant parameter_info_array =>
52             [ { name => 'step',
53             share_key => 'step_2',
54             display => 'Step',
55             type => 'integer',
56             minimum => 0,
57             default => 2,
58             width => 2,
59             description => 'How much longer each row is than the preceding.',
60             },
61             { name => 'align',
62             type => 'enum',
63             share_key => 'align_crl',
64             display => 'Align',
65             default => 'centre',
66             choices => ['centre', 'right', 'left'],
67             choices_display => ['Centre', 'Right', 'Left'],
68             },
69             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
70 2     2   12 ];
  2         4  
71              
72             {
73             my %align_x_negative_step = (left => 1,
74             centre => 2);
75             sub x_negative {
76 18     18 1 56 my ($self) = @_;
77 18         66 my $align = $self->{'align'};
78             return ($align ne 'right'
79 18   66     158 && $self->{'step'} >= $align_x_negative_step{$align});
80             }
81             }
82             sub x_maximum {
83 0     0 1 0 my ($self) = @_;
84 0 0 0     0 return ($self->{'step'} == 0 || $self->{'align'} eq 'left'
85             ? 0 # X=0 vertical, or left X<=0
86             : undef);
87             }
88             {
89             my %x_negative_at_n = (left => 3,
90             right => 5,
91             up => 3,
92             down => 5);
93             sub x_negative_at_n {
94 0     0 1 0 my ($self) = @_;
95             return (($self->{'align'} eq 'left' && $self->{'step'} >= 1)
96 0 0 0     0 || ($self->{'align'} eq 'centre' && $self->{'step'} >= 2)
97             ? $self->n_start + 1
98             : undef);
99             }
100             }
101             sub sumxy_minimum {
102 0     0 1 0 my ($self) = @_;
103             # for align=left step<=1 has X>=-Y so X+Y >= 0
104             # for align=centre step<=3 has X>=-Y so X+Y >= 0
105             # for align=right X>=0 so X+Y >= 0
106             return (($self->{'align'} eq 'left' && $self->{'step'} <= 1)
107             || ($self->{'align'} eq 'centre' && $self->{'step'} <= 3)
108 0 0 0     0 || ($self->{'align'} eq 'right')
109             ? 0
110             : undef);
111             }
112             sub diffxy_maximum {
113 0     0 1 0 my ($self) = @_;
114             # for align=left X<=0 so X-Y<=0 always
115             # for align=centre step<=2 has X<=Y so X-Y<=0
116             # for align=right step<=1 has X<=Y so X-Y<=0
117             return (($self->{'align'} eq 'left')
118             || ($self->{'align'} eq 'centre' && $self->{'step'} <= 2)
119 0 0 0     0 || ($self->{'align'} eq 'right' && $self->{'step'} <= 1)
120             ? 0
121             : undef);
122             }
123              
124             sub dx_minimum {
125 0     0 1 0 my ($self) = @_;
126 0 0       0 return ($self->{'step'} == 0 ? 0 : undef);
127             }
128             sub dx_maximum {
129 0     0 1 0 my ($self) = @_;
130 0 0       0 return ($self->{'step'} == 0
131             ? 0 # vertical only
132             : 1); # East
133             }
134              
135             sub dy_minimum {
136 0     0 1 0 my ($self) = @_;
137 0 0       0 return ($self->{'step'} == 0 ? 1 : 0);
138             }
139 2     2   16 use constant dy_maximum => 1;
  2         4  
  2         459  
140             sub _UNDOCUMENTED__dxdy_list {
141 0     0   0 my ($self) = @_;
142 0 0       0 return ($self->{'step'} == 0 ? (0,1) # N always
143             : ());
144             }
145              
146             sub absdx_minimum {
147 0     0 1 0 my ($self) = @_;
148             return ($self->{'step'} == 0
149             || $self->{'align'} eq 'right' # dX=0 at N=1
150 0 0 0     0 || ($self->{'step'} == 1 && $self->{'align'} eq 'centre')
151             ? 0 : 1);
152             }
153             sub absdy_minimum {
154 0     0 1 0 my ($self) = @_;
155 0 0       0 return ($self->{'step'} == 0 ? 1 : 0);
156             }
157              
158             # within row X increasing dSum=1
159             # end row decrease by big
160             sub dsumxy_minimum {
161 0     0 1 0 my ($self) = @_;
162 0 0       0 return ($self->{'step'} == 0 ? 1 : undef);
163             }
164 2     2   14 use constant dsumxy_maximum => 1;
  2         4  
  2         2074  
165             sub ddiffxy_minimum {
166 0     0 1 0 my ($self) = @_;
167 0 0       0 return ($self->{'step'} == 0 ? -1 # constant North dY=1
168             : undef);
169             }
170             sub ddiffxy_maximum {
171 0     0 1 0 my ($self) = @_;
172 0 0       0 return ($self->{'step'} == 0 ? -1 # constant North dY=1
173             : 1);
174             }
175              
176             sub dir_minimum_dxdy {
177 0     0 1 0 my ($self) = @_;
178 0 0       0 return ($self->{'step'} == 0
179             ? (0,1) # north only
180             : (1,0)); # east
181             }
182             sub dir_maximum_dxdy {
183 0     0 1 0 my ($self) = @_;
184 0 0       0 return ($self->{'step'} == 0
185             ? (0,1) # north only
186             : (-1,0)); # supremum, west and 1 up
187             }
188              
189             sub turn_any_left {
190 0     0 1 0 my ($self) = @_;
191 0         0 return ($self->{'step'} != 0); # always straight vertical only
192             }
193             *turn_any_right = \&turn_any_left;
194              
195              
196             #------------------------------------------------------------------------------
197              
198             my %align_known = (left => 1,
199             right => 1,
200             centre => 1);
201              
202             sub new {
203 94     94 1 8020 my $self = shift->SUPER::new(@_);
204              
205 94 100       274 if (! defined $self->{'n_start'}) {
206 70         159 $self->{'n_start'} = $self->default_n_start;
207             }
208              
209 94   100     374 my $align = ($self->{'align'} ||= 'centre');
210 94 50       235 $align_known{$align}
211             or croak "Unrecognised align option: ",$align;
212              
213 94         171 my $step = $self->{'step'};
214 94 50       316 $step = $self->{'step'} =
    100          
215             (! defined $step ? 2 # default
216             : $step < 0 ? 0 # minimum
217             : $step);
218              
219 94 50       342 my $left_slope = $self->{'left_slope'} = ($align eq 'left' ? $step
    100          
220             : $align eq 'right' ? 0
221             : int($step/2)); # 'centre'
222 94         188 my $right_slope = $self->{'right_slope'} = $step - $left_slope;
223              
224             # "b" term in the quadratic giving N on the Y axis
225 94         165 $self->{'axis_b'} = $left_slope - $right_slope + 2;
226              
227             ### $align
228             ### $step
229             ### $left_slope
230             ### right_slope: $self->{'right_slope'}
231              
232 94         230 return $self;
233             }
234              
235             # step==2 row line beginning at x=-0.5,
236             # y = 0 1 2 3 4
237             # N start = -0.5 1.5 4.5 9.5 16.5
238             #
239             #
240             # step==1
241             # N = (1/2*$d^2 + 1/2*$d + 1/2)
242             # s = -1/2 + sqrt(2 * $n + -3/4)
243             # step==2
244             # N = ($d^2 + 1/2)
245             # s = 0 + sqrt(1 * $n + -1/2)
246             # step==3
247             # N = (3/2*$d^2 + -1/2*$d + 1/2)
248             # s = 1/6 + sqrt(2/3 * $n + -11/36)
249             # step==4
250             # N = (2*$d^2 + -1*$d + 1/2)
251             # s = 1/4 + sqrt(1/2 * $n + -3/16)
252             #
253             # a = $step / 2
254             # b = 1 - $step / 2 = (2-$step)/2
255             # c = 0.5
256             #
257             # s = (-b + sqrt(4*a*$n + b*b - 4*a*c)) / 2*a
258             # = (-b + sqrt(2*$step*$n + b*b - 2*$step*c)) / $step
259             # = (-b + sqrt(2*$step*$n + b*b - $step)) / $step
260             #
261             # N = a*s*s + b*s + c
262             # = $step/2 *s*s + (-$step+2)/2 * s + 1/2
263             # = ($step * $d*$d - ($step-2)*$d + 1) / 2
264             #
265             # left at - 0.5 - $d*int($step/2)
266             # so x = $n - (($step * $d*$d - ($step-2)*$d + 1) / 2) - 0.5 - $d*int($step/2)
267             # = $n - (($step * $d*$d - ($step-2)*$d + 1) / 2 + 0.5 + $d*int($step/2))
268             # = $n - ($step/2 * $d*$d - ($step-2)/2*$d + 1/2 + 0.5 + $d*int($step/2))
269             # = $n - ($step/2 * $d*$d - ($step-2)/2*$d + 1 + $d*int($step/2))
270             # = $n - ($step/2 * $d*$d - ($step-2)/2*$d + int($step/2)*$d + 1)
271             # = $n - ($step/2 * $d*$d - (($step-2)/2 - int($step/2))*$d + 1)
272             # = $n - ($step/2 * $d*$d - ($step/2 - int($step/2) - 1)*$d + 1)
273             # = $n - ($step/2 * $d*$d - (($step&1)/2 - 1)*$d + 1)
274             # = $n - ($step * $d*$d - (($step&1) - 2)*$d + 2)/2
275             #
276             sub n_to_xy {
277 687     687 1 3550 my ($self, $n) = @_;
278             ### PyramidRows n_to_xy(): $n
279              
280             # adjust to N=1 at origin X=0,Y=0
281 687         1081 $n = $n - $self->{'n_start'} + 1;
282              
283             # $n<0.5 no good for Math::BigInt circa Perl 5.12, compare in integers
284 687 100       1413 return if 2*$n < 1;
285              
286 618         960 my $step = $self->{'step'};
287 618 50       1091 if ($step == 0) {
288             # step==0 is vertical line starting N=1 at Y=0
289 0         0 my $int = round_nearest($n);
290 0         0 return ($n-$int, $int-1);
291             }
292              
293 618         855 my $neg_b = $step-2;
294 618         1640 my $y = int (($neg_b + _sqrtint(8*$step*$n + $neg_b*$neg_b - 4*$step))
295             / (2*$step));
296              
297             ### d frac: (($neg_b + sqrt(int(8*$step*$n) + $neg_b*$neg_b - 4*$step)) / (2*$step))
298             ### $y
299             ### centre N: (($self->{'step'}*$y + $self->{'axis_b'})*$y/2+1)
300              
301 618         2020 return ($n - (($self->{'step'}*$y + $self->{'axis_b'})*$y/2+1),
302             $y);
303             }
304              
305             sub n_to_radius {
306 0     0 1 0 my ($self, $n) = @_;
307 0 0       0 if ($self->{'step'} == 0) {
308 0         0 $n = $n - $self->{'n_start'}; # to N=0 basis
309 0 0       0 if ($n < 0) { return undef; }
  0         0  
310 0         0 return $n; # vertical on Y axis, including $n=+infinity or nan
311             }
312 0         0 return $self->SUPER::n_to_radius($n);
313             }
314              
315             # N = ($step * $y*$y - ($step-2)*$y + 1) / 2
316             #
317             # right polygonal
318             # P(i) = (k-2)/2 * i*(i+1) - (k-3)*i
319             # = [(k-2)/2 *(i+1) - (k-3) ]*i
320             # = [(k-2)*(i+1) - 2*(k-3) ]/2*i
321             # = [(k-2)*i + k-2 - 2*(k-3) ]/2*i
322             # = [(k-2)*i + k-2 - 2k+6) ]/2*i
323             # = [(k-2)*i + -k+4 ]/2*i
324             #
325             sub xy_to_n {
326 9222     9222 1 38749 my ($self, $x, $y) = @_;
327 9222         17248 $x = round_nearest ($x);
328 9222         17201 $y = round_nearest ($y);
329              
330 9222 100 66     36970 if ($y < 0
      100        
331             || $x < -$y*$self->{'left_slope'}
332             || $x > $y*$self->{'right_slope'}) {
333 4848         9689 return undef;
334             }
335             return (($self->{'step'}*$y + $self->{'axis_b'})*$y/2
336             + $x
337 4374         11693 + $self->{'n_start'});
338             }
339              
340             # left N = ($step * $d*$d - ($step-2)*$d + 1) / 2
341             # plus .5 = ($step * $d*$d - ($step-2)*$d) / 2 + 1
342             # = (($step * $d - ($step-2))*$d) / 2 + 1
343             #
344             # left X = - $d*int($step/2)
345             # right X = $d * ceil($step/2)
346             #
347             # x_bottom_start = - y1 * step_left
348             # want x2 >= x_bottom_start
349             # x2 >= - y1 * step_left
350             # x2/step_left >= - y1
351             # - x2/step_left <= y1
352             # y1 >= - x2/step_left
353             # y1 >= ceil(-x2/step_left)
354             #
355             # x_bottom_end = y1 * step_right
356             # want x1 <= x_bottom_end
357             # x1 <= y1 * step_right
358             # y1 * step_right >= x1
359             # y1 >= ceil(x1/step_right)
360             #
361             # left N = (($step * $y1 - ($step-2))*$y1) / 2 + 1
362             # bottom_offset = $x1 - $y1 * $step_left
363             # N lo = leftN + bottom_offset
364             # = ((step * y1 - (step-2))*y1) / 2 + 1 + x1 - y1 * step_left
365             # = ((step * y1 - (step-2)-2*step_left)*y1) / 2 + 1 + x1
366             # step_left = floor(step/2)
367             # 2*step_left = step - step&1
368             # N lo = ((step * y1 - (step-2)-2*step_left)*y1) / 2 + 1 + x1
369              
370             # exact
371             sub rect_to_n_range {
372 65     65 1 224 my ($self, $x1,$y1, $x2,$y2) = @_;
373             ### PyramidRows rect_to_n_range(): "$x1,$y1, $x2,$y2 step=$self->{'step'}"
374              
375 65         182 $x1 = round_nearest ($x1);
376 65         133 $y1 = round_nearest ($y1);
377 65         120 $x2 = round_nearest ($x2);
378 65         125 $y2 = round_nearest ($y2);
379 65 100       125 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  9         21  
380 65 100       121 if ($y2 < 0) {
381 9         17 return (1, 0); # rect all negative, no N
382             }
383 56 100       100 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # swap to x1<=x2
  10         19  
384              
385 56         72 my $left_slope = $self->{'left_slope'};
386 56         80 my $right_slope = $self->{'right_slope'};
387              
388 56         80 my $x_top_right = $y2 * $right_slope;
389             ### $x_top_right
390             ### x_top_left: - $y2 * $left_slope
391              
392             # \ | /
393             # \ | /
394             # \ | / +----- x_top_right > x1
395             # \ | / |x1,y2
396             # \|/
397             # -----+-----------
398             #
399             # \ | x_top_start = -y2*step_left
400             # -----+ \ | x_top_start < x2
401             # x2,y2| \ |
402             # \ | /
403             # \|/
404             # -----------+--
405             #
406 56 100 100     158 if ($x1 > $x_top_right
407             || $x2 < - $y2 * $left_slope) {
408             ### rect all off to the left or right, no N ...
409 36         76 return (1, 0);
410             }
411              
412             ### x1 to x2 of top row y2 intersects some of the pyramid ...
413             ### assert: $x2 >= -$y2*$left_slope
414             ### assert: $x1 <= $y2*$right_slope
415              
416             # raise y1 to the lowest row of the rectangle which intersects some of the
417             # pyramid
418 20   100     108 $y1 = max ($y1,
      100        
419             0,
420              
421             # for x2 >= x_bottom_left, round up
422             $left_slope && int((-$x2+$left_slope-1)/$left_slope),
423              
424             # for x1 <= x_bottom_right, round up
425             $right_slope && int(($x1+$right_slope-1)/$right_slope),
426             );
427             ### $y1
428             ### y1 for bottom left: $left_slope && int((-$x2+$left_slope-1)/$left_slope)
429             ### y1 for bottom right: $right_slope && int(($x1+$right_slope-1)/$right_slope)
430             ### assert: $x2 >= -$y1*$left_slope
431             ### assert: $x1 <= $y1*$right_slope
432              
433 20         65 return ($self->xy_to_n (max($x1, -$y1*$left_slope), $y1),
434             $self->xy_to_n (min($x2, $x_top_right), $y2));
435              
436              
437             # my $step = $self->{'step'};
438             # my $sub = ($step&1) - 2;
439             #
440             # ### x bottom start: -$y1*$left_slope
441             # ### x bottom end: $y1*$right_slope
442             # ### $x1
443             # ### $x2
444             # ### bottom left x: max($x1, -$y1*$left_slope)
445             # ### top right x: min ($x2, $x_top_end)
446             # ### $y1
447             # ### $y2
448             # ### n_lo: (($step * $y1 - $sub)*$y1 + 2)/2 + max($x1, -$y1*$left_slope)
449             # ### n_hi: (($step * $y2 - $sub)*$y2 + 2)/2 + min($x2, $x_top_end)
450             #
451             # ### assert: $y1-1==$y1 || (($step * $y1 - $sub)*$y1 + 2) == int (($step * $y1 - $sub)*$y1 + 2)
452             # ### assert: $y2-1==$y2 || (($step * $y2 - $sub)*$y2 + 2) == int (($step * $y2 - $sub)*$y2 + 2)
453              
454             # (($step * $y1 - $sub)*$y1 + 2)/2
455             # + max($x1, -$y1*$left_slope), # x_bottom_start
456             #
457             # (($step * $y2 - $sub)*$y2 + 2)/2
458             # + min($x2, $x_top_end));
459             #
460             # # return ($self->xy_to_n (max ($x1, -$y1*$left_slope), $y1),
461             # # $self->xy_to_n (min ($x2, $x_top_end), $y2));
462             }
463              
464             1;
465             __END__