File Coverage

blib/lib/Math/PlanePath/StaircaseAlternating.pm
Criterion Covered Total %
statement 115 134 85.8
branch 51 64 79.6
condition 46 50 92.0
subroutine 17 21 80.9
pod 7 7 100.0
total 236 276 85.5


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 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=StaircaseAlternating --all --output=numbers_dash --size=70x30
21             # math-image --path=StaircaseAlternating,end_type=square --all --output=numbers_dash --size=70x30
22              
23             package Math::PlanePath::StaircaseAlternating;
24 1     1   1196 use 5.004;
  1         4  
25 1     1   6 use strict;
  1         2  
  1         26  
26              
27 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         71  
28             $VERSION = 128;
29 1     1   715 use Math::PlanePath;
  1         3  
  1         41  
30             @ISA = ('Math::PlanePath');
31              
32             use Math::PlanePath::Base::Generic
33 1     1   6 'round_nearest';
  1         2  
  1         39  
34 1     1   495 use Math::PlanePath::Base::NSEW;
  1         3  
  1         41  
35             *_sqrtint = \&Math::PlanePath::_sqrtint;
36              
37             # uncomment this to run the ### lines
38             #use Smart::Comments;
39              
40              
41 1     1   6 use constant class_x_negative => 0;
  1         2  
  1         46  
42 1     1   6 use constant class_y_negative => 0;
  1         2  
  1         135  
43              
44             my %n_frac_discontinuity = (jump => .5);
45             sub n_frac_discontinuity {
46 0     0 1 0 my ($self) = @_;
47 0         0 return $n_frac_discontinuity{$self->{'end_type'}};
48             }
49              
50 1         52 use constant parameter_info_array =>
51             [ { name => 'end_type',
52             share_key => 'end_type_jumpsquare',
53             display => 'Type',
54             type => 'enum',
55             default => 'jump',
56             choices => ['jump','square'],
57             choices_display => ['Jump','Wquare'],
58             },
59             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
60 1     1   6 ];
  1         2  
61              
62              
63             #------------------------------------------------------------------------------
64 1     1   6 use constant dx_minimum => -1;
  1         2  
  1         103  
65             {
66             my %dx_maximum = (jump => 2,
67             square => 1);
68             sub dx_maximum {
69 0     0 1 0 my ($self) = @_;
70 0         0 return $dx_maximum{$self->{'end_type'}};
71             }
72             }
73 1     1   7 use constant dy_minimum => -1;
  1         2  
  1         127  
74             *dy_maximum = \&dx_maximum;
75             sub _UNDOCUMENTED__dxdy_list {
76 0     0   0 my ($self) = @_;
77 0 0       0 return ($self->{'end_type'} eq 'jump'
78             ? (1,0, # E
79             2,0, # E by 2
80             0,1, # N
81             0,2, # N by 2
82             -1,0, # W
83             0,-1) # S
84             : Math::PlanePath::Base::NSEW->_UNDOCUMENTED__dxdy_list);
85             }
86              
87 1     1   7 use constant dsumxy_minimum => -1; # straight S
  1         2  
  1         149  
88             *dsumxy_maximum = \&dx_maximum;
89              
90             {
91             my %dDiffXY_max = (jump => -2,
92             square => -1);
93             sub ddiffxy_minimum {
94 0     0 1 0 my ($self) = @_;
95 0         0 return $dDiffXY_max{$self->{'end_type'}};
96             }
97             }
98             *ddiffxy_maximum = \&dx_maximum;
99              
100 1     1   7 use constant dir_maximum_dxdy => (0,-1); # South
  1         2  
  1         1049  
101              
102              
103             #------------------------------------------------------------------------------
104             sub new {
105 6     6 1 913 my $self = shift->SUPER::new(@_);
106 6   100     34 $self->{'end_type'} ||= 'jump';
107 6 50       17 if (! defined $self->{'n_start'}) {
108 6         28 $self->{'n_start'} = $self->default_n_start;
109             }
110 6         15 return $self;
111             }
112              
113             # --16
114             # |
115             # 17--18
116             # |
117             # --15 19--20
118             # | |
119             # 14--13 21--22
120             # | |
121             # --2 12--11 23--24 34--33
122             # | | | |
123             # 3-- 4 10-- 9 25--26 32--31
124             # | | | |
125             # --1 5-- 6 8-- 7 27--28 30--29
126              
127             # 17
128             # |\
129             # 16 18
130             # | |
131             # 15 19-20
132             # | |
133             # 14-13 21-22
134             # | |
135             # 3 12-11 23-24 34-33
136             # |\ | | |
137             # 2 4 10--9 25-26 32-31
138             # | | \ | \
139             # 1 5--6--7--8 27-28-29-30
140              
141             # .
142             #
143             # 42-43
144             # | |
145             # 41 44-45
146             # | |
147             # 40-39 46-47
148             # | |
149             # . 38-37 48-
150             # |
151             # 14-15 35-36
152             # | | |
153             # 13 16-17 34-33
154             # | | |
155             # 12-11 18-19 32-31
156             # | | |
157             # . 10--9 20-21 30-29
158             # | | |
159             # 2--3 8--7 22-23 28-27
160             # | | | | |
161             # 1 4--5--6 . 24-25-26 .
162             #
163             # start from integer vertical
164             # d = [ 2, 3, 4, 5 ]
165             # N = [ 5, 13, 25, 41 ]
166             # N = (2 d^2 - 2 d + 1)
167             # = ((2*$d - 2)*$d + 1)
168             # d = 1/2 + sqrt(1/2 * $n + -1/4)
169             # = (1 + sqrt(2*$n - 1)) / 2
170             #
171              
172             sub n_to_xy {
173 6     6 1 424 my ($self, $n) = @_;
174             #### StaircaseAlternating n_to_xy: $n
175              
176             # adjust to N=1 at origin X=0,Y=0
177 6         11 $n = $n - $self->{'n_start'} + 1;
178              
179 6         7 my $d;
180 6 50       15 if ($self->{'end_type'} eq 'square') {
181 6 50       19 if ($n < 1) { return; }
  0         0  
182              
183 6         17 $d = int( (1 + _sqrtint(2*$n-1)) / 2 );
184 6         12 $n -= (2*$d - 2)*$d;
185             ### $d
186             ### remainder n: $n
187              
188 6 100       24 if ($n < 2) {
189 2 100       7 if ($d % 2) {
190 1         12 return (0, $n+2*$d-3);
191             } else {
192 1         3 return ($n+2*$d-3, 0);
193             }
194             }
195              
196             } else {
197 0 0       0 if (2*$n < 1) { return; }
  0         0  
198              
199 0         0 $d = int ((1 + _sqrtint(8*$n-3)) / 4);
200 0         0 $n -= (2*$d - 1)*$d;
201             ### rem: $n
202             }
203              
204 4         5 my $int = int($n);
205 4         7 my $frac = $n - $int;
206 4         5 my $r = int($int/2);
207              
208 4         6 my ($x,$y);
209 4 100       9 if ($int % 2) {
210             ### down ...
211 1         2 $x = $r;
212 1         2 $y = -$frac + 2*$d - $r;
213             } else {
214             ### across ...
215 3         5 $x = $frac + $r-1;
216 3         5 $y = 2*$d - $r;
217             }
218              
219 4 100       8 if ($d % 2) {
220 3         8 return ($x,$y);
221             } else {
222 1         3 return ($y,$x);
223             }
224             }
225              
226             sub xy_to_n {
227 179988     179988 1 485316 my ($self, $x, $y) = @_;
228             ### StaircaseAlternating xy_to_n(): "$x,$y"
229              
230 179988         326834 $x = round_nearest ($x);
231 179988         329132 $y = round_nearest ($y);
232 179988 50 33     505152 if ($x < 0 || $y < 0) {
233 0         0 return undef;
234             }
235              
236 179988         278293 my $jump = ($self->{'end_type'} ne 'square');
237 179988 100       302754 unless ($jump) {
238             # square omitted endpoints
239 89988 100 100     219418 if ($x == 0) {
    100          
240 1698 100       3114 if (($y % 4) == 2) {
241 335         706 return undef;
242             }
243             } elsif ($y == 0 && ($x % 4) == 0) {
244 322         768 return undef;
245             }
246             }
247              
248 179331         293876 my $d = int(($x + $y + 1) / 2);
249             return ((2*$d + $jump) * $d
250             + ($d % 2
251             ? $x - $y
252             : $y - $x)
253 179331 100       480127 + $self->{'n_start'});
254             }
255              
256             # 12--11 18--19 14--13 21--22
257             # | | | |
258             # . 10-- 9 20 2 12--11 23
259             # | | |
260             # 2-- 3 8-- 7 3-- 4 10-- 9
261             # | | | | |
262             # 1 4-- 5-- 6 1 5-- 6 8
263             #
264             my @yx_to_min_dx = (0, 0, 0, -1,
265             0, 0, 1, 0,
266             0, 1, 0, 0,
267             1, 0, 0, 0);
268             my @yx_to_min_dy = (0, 1, 0, 0,
269             -1, 0, 0, 0,
270             0, 0, 0, 1,
271             0, 0, 1, 0);
272              
273             my @yx_to_max_dx = (1, 0, 0, 0,
274             0, 0, 0, 1,
275             0, 0, 1, 0,
276             0, 1, 0, 0);
277             my @yx_to_max_dy = (0, 0, 1, 0,
278             0, 1, 0, 0,
279             1, 0, 0, 0,
280             0, 0, 0, 1);
281              
282             # exact
283             sub rect_to_n_range {
284 20000     20000 1 89019 my ($self, $x1,$y1, $x2,$y2) = @_;
285             ### StaircaseAlternating rect_to_n_range(): "$x1,$y1 $x2,$y2"
286              
287 20000         38225 $x1 = round_nearest ($x1);
288 20000         37387 $y1 = round_nearest ($y1);
289 20000         36745 $x2 = round_nearest ($x2);
290 20000         36195 $y2 = round_nearest ($y2);
291 20000 50       38379 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # x2 > x1
  0         0  
292 20000 50       34331 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # y2 > y1
  0         0  
293              
294 20000 50 33     57311 if ($x2 < 0 || $y2 < 0) {
295             ### entirely outside first quadrant ...
296 0         0 return (1, 0);
297             }
298              
299             # not less than 0,0
300 20000 50       34482 if ($x1 < 0) { $x1 *= 0; }
  0         0  
301 20000 50       32083 if ($y1 < 0) { $y1 *= 0; }
  0         0  
302              
303 20000         26715 my $corner_x1 = $x1;
304 20000         26091 my $corner_y1 = $y1;
305 20000         27237 my $corner_x2 = $x2;
306 20000         27432 my $corner_y2 = $y2;
307             {
308 20000         26324 my $key = 4*($y2 % 4) + ($x2 % 4);
  20000         31989  
309 20000 100 100     73745 if ($x2 > $x1 && $yx_to_max_dx[$key]) {
    100 100        
310 3752         6127 $corner_x2 -= 1;
311             } elsif ($y2 > 0 && $y2 > $y1) {
312 12184         19633 $corner_y2 -= $yx_to_max_dy[$key];
313             }
314             }
315              
316 20000         35682 my $square = ($self->{'end_type'} eq 'square');
317 20000 100 100     77296 if ($square && $x1 == 0 && ($y1 % 4) == 2) {
    100 100        
      100        
      100        
      100        
318             ### x1,y1 is an omitted Y axis point ...
319 96 100       192 if ($corner_x1 < $x2) {
    100          
320 72         111 $corner_x1 += 1;
321             } elsif ($corner_y1 < $y2) {
322 18         32 $corner_y1 += 1;
323             } else {
324             ### only this point ...
325 6         18 return (1, 0);
326             }
327              
328             } elsif ($square && $y1 == 0 && $x1 > 0 && ($x1 % 4) == 0) {
329 96 100       535 if ($corner_y1 < $y2) {
    100          
330 72         99 $corner_y1 += 1;
331             } elsif ($corner_x1 < $x2) {
332 18         40 $corner_x1 += 1;
333             } else {
334             ### only an omitted X axis point ...
335 6         28 return (1, 0);
336             }
337              
338             }
339             {
340 19988         26600 my $key = 4*($corner_y1 % 4) + ($corner_x1 % 4);
  19988         31581  
341             ### min key: $key
342 19988 100 100     70890 if ($corner_x1 < $x2 && (my $dx = $yx_to_min_dx[$key])) {
    100 100        
343             ### x1 incr ...
344 3792 100 100     9841 unless ($square && $dx < 0 && $corner_y1 == 0) {
      100        
345 3720         5839 $corner_x1 += 1;
346             }
347             } elsif ($corner_y1 < $y2 && (my $dy = $yx_to_min_dy[$key])) {
348             ### y1 incr ...
349 3792 100 100     9466 unless ($square && $dy < 0 && $corner_x1 == 0) {
      100        
350 3720         5643 $corner_y1 += 1;
351             }
352             }
353             }
354              
355             ### corners: "$x1,$y1 $x2,$y2"
356              
357 19988         36740 return ($self->xy_to_n($corner_x1,$corner_y1),
358             $self->xy_to_n($corner_x2,$corner_y2));
359             }
360              
361             # inexact but easier ...
362             #
363             # if ($self->{'end_type'} eq 'square') {
364             # $x2 += $y2 + 1;
365             # $x2 = int($x2/2);
366             # return (1,
367             # (2*$x2+2)*$x2 + 1);
368             # } else {
369             # $x2 += $y2 + 2;
370             # return (1,
371             # $x2*($x2+1)/2);
372             # }
373              
374             1;
375             __END__