File Coverage

blib/lib/Math/PlanePath/Corner.pm
Criterion Covered Total %
statement 96 111 86.4
branch 24 34 70.5
condition 4 8 50.0
subroutine 20 24 83.3
pod 6 6 100.0
total 150 183 81.9


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
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             # cf Matthew Szudzik ElegantPairing.pdf going inwardly.
20             #
21             # 5 | 25--...
22             # |
23             # 4 | 16--17--18--19 24
24             # | |
25             # 3 | 9--10--11 15 23
26             # | | |
27             # 2 | 4-- 5 8 14 22
28             # | | | |
29             # 1 | 1 4 7 13 21
30             # | | | | |
31             # Y=0 | 0 2 6 12 20
32             # +---------------------
33             # X=0 1 2 3 4
34             #
35             # cf A185728 where diagonal is last in each gnomon
36             # A185725 gnomon sides alternately starting from ends
37             # A185726 gnomon sides alternately starting from diagonal
38             #
39             # corner going alternately up and down
40             # A081344,A194280 by diagonals
41             # A081345 X axis, A081346 Y axis
42             #
43             # corner alternately up and down, starting with 3-wide
44             # A080335 N on diagonal
45             # A081347 N on axis
46             # A081348 N on axis
47             #
48             # cf A004120 ??
49             #
50             #----------
51             # corners alternating "shell"
52             #
53             # A319514 interleaved x,y
54             # my(g=OEIS_bfile_gf("A319289")); x(n) = polcoeff(g,n);
55             # my(g=OEIS_bfile_gf("A319290")); y(n) = polcoeff(g,n);
56             # plothraw(vector(3^3,n,n--; x(n)), \
57             # vector(3^3,n,n--; y(n)), 1+8+16+32)
58              
59              
60              
61             package Math::PlanePath::Corner;
62 2     2   2332 use 5.004;
  2         9  
63 2     2   14 use strict;
  2         4  
  2         56  
64 2     2   12 use List::Util 'min';
  2         9  
  2         214  
65              
66 2     2   14 use vars '$VERSION', '@ISA';
  2         4  
  2         167  
67             $VERSION = 128;
68 2     2   772 use Math::PlanePath;
  2         5  
  2         109  
69             *_sqrtint = \&Math::PlanePath::_sqrtint;
70             @ISA = ('Math::PlanePath');
71              
72             use Math::PlanePath::Base::Generic
73 2     2   14 'round_nearest';
  2         3  
  2         100  
74              
75             # uncomment this to run the ### lines
76             # use Smart::Comments;
77              
78              
79 2     2   14 use constant class_x_negative => 0;
  2         4  
  2         127  
80 2     2   12 use constant class_y_negative => 0;
  2         29  
  2         98  
81 2     2   12 use constant n_frac_discontinuity => .5;
  2         4  
  2         122  
82             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
83              
84 2     2   1189 use Math::PlanePath::SquareSpiral;
  2         5  
  2         97  
85             *parameter_info_array = \&Math::PlanePath::SquareSpiral::parameter_info_array;
86              
87 2     2   14 use constant dx_maximum => 1;
  2         4  
  2         108  
88 2     2   12 use constant dy_minimum => -1;
  2         5  
  2         170  
89              
90             # dSum east dX=1,dY=0 for dSum=+1
91             # south dX=0,dY=-1 for dSum=-1
92             # gnomon up to start of next gnomon is
93             # X=wider+k,Y=0 to X=0,Y=k+1
94             # dSum = 0-(wider+k) + (k+1)-0
95             # = -wider-k + k + 1
96             # = 1-wider
97             sub dsumxy_minimum {
98 0     0 1 0 my ($self) = @_;
99 0         0 return min(-1, 1-$self->{'wider'});
100             }
101 2     2   13 use constant dsumxy_maximum => 1; # East along top
  2         4  
  2         123  
102              
103             # dDiffXY east dX=1,dY=0 for dDiffXY=1-0 = 1
104             # south dX=0,dY=-1 for dDiffXY=0-(-1) = 1
105             # gnomon up to start of next gnomon is
106             # X=wider+k,Y=0 to X=0,Y=k+1
107             # dDiffXY = 0-(wider+k) - ((k+1)-0)
108             # = -wider - 2*k - 1 unbounded negative
109 2     2   13 use constant ddiffxy_maximum => 1; # East along top
  2         5  
  2         110  
110              
111             # use constant dir_minimum_dxdy => (1,0); # East at N=2
112 2     2   13 use constant dir_maximum_dxdy => (0,-1); # South at N=3
  2         12  
  2         1642  
113              
114             sub turn_any_left {
115 0     0 1 0 my ($self) = @_;
116 0         0 return ($self->{'wider'} != 0); # wider=0 no left, right or straight always
117             }
118             sub _UNDOCUMENTED__turn_any_left_at_n {
119 0     0   0 my ($self) = @_;
120 0 0       0 return ($self->{'wider'} ? $self->n_start + $self->{'wider'}
121             : undef); # wider=0 no left
122             }
123             sub _UNDOCUMENTED__turn_any_right_at_n {
124 0     0   0 my ($self) = @_;
125 0         0 return $self->n_start + $self->{'wider'} + 1;
126             }
127              
128              
129             #------------------------------------------------------------------------------
130              
131             # same as PyramidSides, just 45 degress around
132              
133             sub new {
134 57     57 1 7359 my $self = shift->SUPER::new (@_);
135 57 50       163 if (! defined $self->{'n_start'}) {
136 57         155 $self->{'n_start'} = $self->default_n_start;
137             }
138 57   100     126 $self->{'wider'} ||= 0; # default
139 57         106 return $self;
140             }
141              
142             sub n_to_xy {
143 101     101 1 7026 my ($self, $n) = @_;
144             ### Corner n_to_xy: $n
145              
146             # adjust to N=1 at origin X=0,Y=0
147 101         191 $n = $n - $self->{'n_start'} + 1;
148              
149             # comparing $n<0.5, but done in integers for the benefit of Math::BigInt
150 101 100       1238 if (2*$n < 1) {
151 1         246 return;
152             }
153              
154 100         707 my $wider = $self->{'wider'};
155              
156             # wider==0
157             # vertical at X=0 has N=1, 2, 5, 10, 17, 26
158             # but start 0.5 back so at X=-0.5 have N=0.5, 1.5, 4.5, 9.5, 16.5, 25.5
159             # N = (Y^2 + 1/2)
160             # Y = floor sqrt(N - 1/2)
161             # = floor sqrt(4*N - 2)/2 staying in integers for the sqrt()
162             #
163             # wider==1
164             # 0.5 back so at X=-0.5 have N=0.5, 2.5, 6.5, 12.5
165             # N = (Y^2 + Y + 1/2)
166             # Y = floor -1/2 + sqrt(N - 1/4)
167             # = floor (-1 + sqrt(4*N - 1))/2
168             #
169             # wider==2
170             # 0.5 back so at X=-0.5 have N=0.5, 3.5, 8.5, 15.5
171             # N = (Y^2 + 2 Y + 1/2)
172             # Y = floor -1 + sqrt(N + 1/2)
173             # = floor (-2 + sqrt(4*N + 2))/2
174             #
175             # wider==3
176             # 0.5 back so at X=-0.5 have N=0.5, 4.5, 10.5, 18.5
177             # N = (Y^2 + 3 Y + 1/2)
178             # Y = floor -3/2 + sqrt(N + 7/4)
179             # = floor (-3 + sqrt(4*N + 7))/2
180             #
181             # 0,1,4,9
182             # my $y = int((sqrt(4*$n + -1) - $wider) / 2);
183             # ### y frac: (sqrt(4*$n + -1) - $wider) / 2
184              
185 100         275 my $y = int((_sqrtint(4*$n + $wider*$wider - 2) - $wider) / 2);
186             ### y frac: (sqrt(int(4*$n) + $wider*$wider - 2) - $wider) / 2
187             ### $y
188              
189             # diagonal at X=Y has N=1, 3, 7, 13, 21
190             # N = ((Y + 1)*Y + (Y+1)*wider + 1)
191             # = ((Y + 1 + wider)*Y + wider + 1)
192             # so subtract that leaving N negative on the horizontal part, or positive
193             # for the downward vertical part
194             #
195 100         5528 $n -= $y*($y+1+$wider) + $wider + 1;
196             ### corner n: $y*($y+1+$wider) + $wider + 1
197             ### rem: $n
198             ### assert: $n!=$n || $n >= -($y+$wider+0.5)
199             # ### assert: $n <= ($y+0.5)
200              
201 100 100       2163 if ($n < 0) {
202             # top horizontal
203 62         345 return ($n + $y+$wider,
204             $y);
205             } else {
206             # right vertical
207 38         249 return ($y+$wider,
208             -$n + $y);
209             }
210             }
211              
212             sub xy_to_n {
213 392     392 1 6777 my ($self, $x, $y) = @_;
214             ### Corner xy_to_n(): "$x,$y"
215              
216 392         726 $x = round_nearest ($x);
217 392         751 $y = round_nearest ($y);
218 392 50 33     1231 if ($x < 0 || $y < 0) {
219 0         0 return undef;
220             }
221              
222 392         1054 my $wider = $self->{'wider'};
223 392         500 my $xw = $x - $wider;
224 392 100       818 if ($y >= $xw) {
225             ### top edge, N left is: $y*$y + $wider*$y + 1
226             return ($y*$y + $wider*$y # Y axis N value
227             + $x # plus X offset across
228 295         927 + $self->{'n_start'});
229             } else {
230             ### right vertical, N diag is: $xw*$xw + $xw*$wider
231             ### $xw
232             # Ndiag = Nleft + Y+w
233             # N = xw*xw + w*xw + 1 + xw+w + (xw - y)
234             # = xw*xw + w*xw + 1 + xw+w + xw - y
235             # = xw*xw + xw*(w+2) + 1 + w - y
236             # = xw*(xw + w+2) + w+1 - y
237             return ($xw*($xw+$wider+2) + $wider
238             - $y
239 97         240 + $self->{'n_start'});
240             }
241             }
242              
243             # exact
244             sub rect_to_n_range {
245 146     146 1 10514 my ($self, $x1,$y1, $x2,$y2) = @_;
246             ### Corner rect_to_n_range(): "$x1,$y1, $x2,$y2"
247              
248 146         364 $x1 = round_nearest ($x1);
249 146         273 $y1 = round_nearest ($y1);
250 146         279 $x2 = round_nearest ($x2);
251 146         277 $y2 = round_nearest ($y2);
252 146 50       311 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
  0         0  
253 146 50       283 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); }
  0         0  
254              
255 146 50 33     504 if ($y2 < 0 || $x2 < 0) {
256 0         0 return (1, 0); # rect all negative, no N
257             }
258              
259 146 50       237 if ($x1 < 0) { $x1 *= 0; } # "*=" to preserve bigint x1 or y1
  0         0  
260 146 50       241 if ($y1 < 0) { $y1 *= 0; }
  0         0  
261              
262 146         255 my $wider = $self->{'wider'};
263 146         198 my $ylo = $y1;
264 146         212 my $xw = $x1 - $wider;
265              
266 146 100       241 if ($y1 <= $xw) {
267             # left column is partly or wholly below X=Y diagonal
268             #
269             # make x1,y1 the min pos
270 53 100       97 $y1 = ($y2 < $xw
271              
272             # wholly below diag, min "*" is at top y2 of the x1 column
273             #
274             # | /
275             # | /
276             # | / *------+ y2
277             # | / | |
278             # | / +------+ y1
279             # | / x1 x2
280             # +------------------
281             # ^.....^
282             # wider xw
283             #
284             ? $y2
285              
286             # only partly below diag, min "*" is the X=Y+wider diagonal at x1
287             #
288             # /
289             # | +------+ y2
290             # | | / |
291             # | |/ |
292             # | * |
293             # | /| |
294             # | / +------+ y1
295             # | / x1 x2
296             # +------------------
297             # ^...^xw
298             # wider
299             #
300             : $xw);
301             }
302              
303 146 100       266 if ($y2 <= $x2 - $wider) {
304             # right column entirely at or below X=Y+wider diagonal so max is at the
305             # ylo bottom end of the column
306             #
307             # | /
308             # | --/---+ y2
309             # | | / |
310             # | |/ |
311             # | / |
312             # | /| |
313             # | / +------+ ylo
314             # | / x2
315             # +------------------
316             # ^
317             # wider
318             #
319 60         76 $y2 = $ylo; # x2,y2 now the max pos
320             }
321              
322             ### min xy: "$x1,$y1"
323             ### max xy: "$x2,$y2"
324 146         288 return ($self->xy_to_n ($x1,$y1),
325             $self->xy_to_n ($x2,$y2));
326             }
327              
328             #------------------------------------------------------------------------------
329              
330             sub _NOTDOCUMENTED_n_to_figure_boundary {
331 36     36   4354 my ($self, $n) = @_;
332             ### _NOTDOCUMENTED_n_to_figure_boundary(): $n
333              
334             # adjust to N=1 at origin X=0,Y=0
335 36         77 $n = $n - $self->{'n_start'} + 1;
336              
337 36 50       100 if ($n < 1) {
338 0         0 return undef;
339             }
340              
341 36         56 my $wider = $self->{'wider'};
342 36 100       66 if ($n <= $wider) {
343             # single block row
344             # +---+-----+----+
345             # | 1 | ... | $n | boundary = 2*N + 2
346             # +---+-----+----+
347 4         12 return 2*$n + 2;
348             }
349              
350 32         93 my $d = int((_sqrtint(4*$n + $wider*$wider - 2) - $wider) / 2);
351             ### $d
352             ### $wider
353              
354 32 100       69 if ($n > $d*($d+1+$wider) + $wider) {
355 17         23 $wider++;
356             ### increment for +2 after turn ...
357             }
358 32         63 return 4*$d + 2*$wider + 2;
359             }
360              
361             #------------------------------------------------------------------------------
362             1;
363             __END__