File Coverage

blib/lib/Math/PlanePath/TriangularHypot.pm
Criterion Covered Total %
statement 230 267 86.1
branch 62 90 68.8
condition 14 17 82.3
subroutine 12 21 57.1
pod 11 11 100.0
total 329 406 81.0


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 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             # math-image --path=TriangularHypot
20              
21             # A034017 - loeschian primatives xx+xy+yy, primes 3k+1 and a factor of 3
22             # which is when x^2-x+1 mod n has a solution
23             #
24             # A092572 - all x^2+3*y^2
25             # A158937 - all x^2+3*y^2 with repetitions x>0,y>0
26             #
27             # A092572 - 6n+1 primes
28             # A055664 - norms of Eisenstein-Jacobi primes
29             # A008458 - hex coordination sequence, 1 and multiples of 6
30             #
31             # A2 centred at lattice point:
32             # A014201 - x*x+x*y+y*y solutions excluding 0,0
33             # A038589 - lattice sizes, =A014201+1
34             # A038590 - sizes, uniques of A038589
35             # A038591 - 3fold symmetry, union A038588 and A038590
36             #
37             # A2 centred at hole
38             # A038587 - centred deep hole
39             # A038588 - centred deep hole uniques of A038587
40             # A005882 - theta relative hole
41             # 3,3,6,0,6,3,6,0,3,6,6,0,6,0,6,0,9,6,0,0,6,3,6,0,6,6,6,0,0,0,12,
42             # A033685 - theta series of hexagonal lattice A_2 with respect to deep hole.
43             # 1/3 steps of norm, so extra zeros
44             # 0,3,0,0,3,0,0,6,0,0,0,0,0,6,0,0,3,0,0,6,0,0,0,0,0,3,0,0,6,0,0,6,
45             #
46             # A005929 Theta series of hexagonal net with respect to mid-point of edge.
47              
48             # [27] [28] [31]
49             # [12] [13] [16] [21] [28]
50             # [7] [4] [3] [4] [7] [12] [19] [28]
51             # [25] [16] [9] [4] [1] [0] [1] [4] [9] [16] [25] [36]
52             # [7] [4] [3] [4] [7]
53             # [12]
54             # [27]
55              
56             # mirror across +60
57             # (X,Y) = ((X+3Y)/2, (Y-X)/2); # rotate -60
58             # Y = -Y; # mirror
59             # (X,Y) = ((X-3Y)/2, (X+Y)/2); # rotate +60
60             #
61             # (X,Y) = ((X+3Y)/2, (Y-X)/2); # rotate -60
62             # (X,Y) = ((X+3Y)/2, (X-Y)/2);
63             #
64             # (X,Y) = (((X+3Y)/2+3(Y-X)/2)/2, ((X+3Y)/2-(Y-X)/2)/2);
65             # = (((X+3Y)+3(Y-X))/4, ((X+3Y)-(Y-X))/4);
66             # = ((X + 3Y + 3Y - 3X)/4, (X + 3Y - Y + X)/4);
67             # = ((-2X + 6Y)/4, (2X + 2Y)/4);
68             # = ((-X + 3Y)/2, (X+Y)/2);
69             # # eg X=6,Y=0 -> X=-6/2=-3 Y=(6+0)/2=3
70              
71              
72             package Math::PlanePath::TriangularHypot;
73 1     1   1553 use 5.004;
  1         4  
74 1     1   5 use strict;
  1         2  
  1         24  
75 1     1   4 use Carp 'croak';
  1         2  
  1         51  
76              
77 1     1   6 use vars '$VERSION', '@ISA';
  1         2  
  1         81  
78             $VERSION = 127;
79 1     1   786 use Math::PlanePath;
  1         2  
  1         42  
80             @ISA = ('Math::PlanePath');
81              
82             use Math::PlanePath::Base::Generic
83 1         73 'is_infinite',
84 1     1   7 'round_nearest';
  1         2  
85              
86             # uncomment this to run the ### lines
87             # use Smart::Comments;
88              
89              
90 1         3032 use constant parameter_info_array =>
91             [ { name => 'points',
92             share_type => 'points_eoahrc',
93             display => 'Points',
94             type => 'enum',
95             default => 'even',
96             choices => ['even','odd', 'all',
97             'hex','hex_rotated','hex_centred',
98             ],
99             choices_display => ['Even','Odd', 'All',
100             'Hex','Hex Rotated','Hex Centred',
101             ],
102             description => 'Which X,Y points visit, either X+Y even or odd, or all points, or hexagonal grid points.',
103             },
104             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
105 1     1   5 ];
  1         2  
106              
107             {
108             my %x_negative_at_n = (even => 3,
109             odd => 1,
110             all => 2,
111             hex => 2,
112             hex_rotated => 2,
113             hex_centred => 2,
114             );
115             sub x_negative_at_n {
116 0     0 1 0 my ($self) = @_;
117 0         0 return $self->n_start + $x_negative_at_n{$self->{'points'}};
118             }
119             }
120             {
121             my %y_negative_at_n = (even => 5,
122             odd => 3,
123             all => 4,
124             hex => 3,
125             hex_rotated => 3,
126             hex_centred => 4,
127             );
128             sub y_negative_at_n {
129 0     0 1 0 my ($self) = @_;
130 0         0 return $self->n_start + $y_negative_at_n{$self->{'points'}};
131             }
132             }
133             sub rsquared_minimum {
134 0     0 1 0 my ($self) = @_;
135             return ($self->{'points'} eq 'odd' ? 1 # at X=1,Y=0
136 0 0       0 : $self->{'points'} eq 'hex_centred' ? 2 # at X=1,Y=1
    0          
137             : 0); # even,all,hex,hex_rotated at X=0,Y=0
138             }
139             *sumabsxy_minimum = \&rsquared_minimum;
140              
141             sub absdiffxy_minimum {
142 0     0 1 0 my ($self) = @_;
143 0 0       0 return ($self->{'points'} eq 'odd'
144             ? 1 # odd, line X=Y not included
145             : 0); # even,all includes X=Y
146             }
147              
148             {
149             my %_UNDOCUMENTED__turn_any_left_at_n
150             = (even => 1,
151             odd => 3,
152             all => 4,
153             hex => 1,
154             hex_rotated => 1,
155             hex_centred => 1,
156             );
157             sub _UNDOCUMENTED__turn_any_left_at_n {
158 0     0   0 my ($self) = @_;
159 0         0 my $n = $_UNDOCUMENTED__turn_any_left_at_n{$self->{'points'}};
160 0 0       0 return (defined $n ? $self->n_start + $n : undef);
161             }
162             }
163             {
164             # even,hex, left or straight only
165             # odd,all both left or right
166             my %turn_any_right = (# even => 0,
167             odd => 1,
168             all => 1,
169             # hex => 0,
170             # hex_rotated => 0,
171             # hex_centred => 0,
172             );
173             sub turn_any_right {
174 0     0 1 0 my ($self) = @_;
175 0         0 return $turn_any_right{$self->{'points'}};
176             }
177             }
178              
179             sub turn_any_straight {
180 0     0 1 0 my ($self) = @_;
181             return ($self->{'points'} eq 'hex'
182 0 0 0     0 || $self->{'points'} eq 'odd' ? 0 # never straight
183             : 1);
184             }
185             {
186             my %_UNDOCUMENTED__turn_any_straight_at_n
187             = (even => 30,
188             # odd => undef, # never straight
189             all => 1,
190             # hex => undef, # never straight
191             hex_rotated => 57,
192             hex_centred => 23,
193             );
194             sub _UNDOCUMENTED__turn_any_straight_at_n {
195 0     0   0 my ($self) = @_;
196 0         0 my $n = $_UNDOCUMENTED__turn_any_straight_at_n{$self->{'points'}};
197 0 0       0 return (defined $n ? $self->n_start + $n : undef);
198             }
199             }
200              
201             #------------------------------------------------------------------------------
202              
203             sub new {
204             ### TriangularHypot new() ...
205 13     13 1 5339 my $self = shift->SUPER::new(@_);
206              
207 13 50       62 if (! defined $self->{'n_start'}) {
208 13         62 $self->{'n_start'} = $self->default_n_start;
209             }
210              
211 13   100     51 my $points = ($self->{'points'} ||= 'even');
212 13 100       79 if ($points eq 'all') {
    100          
    100          
    100          
    100          
    50          
213 2         7 $self->{'n_to_x'} = [0];
214 2         6 $self->{'n_to_y'} = [0];
215 2         6 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
216 2         6 $self->{'y_next_x'} = [1-1];
217 2         5 $self->{'y_next_hypot'} = [3*0**2 + 1**2];
218 2         7 $self->{'x_inc'} = 1;
219 2         6 $self->{'x_inc_factor'} = 2; # ((x+1)^2 - x^2) = 2*x+1
220 2         5 $self->{'x_inc_squared'} = 1;
221 2         5 $self->{'symmetry'} = 4;
222              
223             } elsif ($points eq 'even') {
224 4         14 $self->{'n_to_x'} = [0];
225 4         8 $self->{'n_to_y'} = [0];
226 4         8 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
227 4         10 $self->{'y_next_x'} = [2-2];
228 4         10 $self->{'y_next_hypot'} = [3*0**2 + 2**2];
229 4         13 $self->{'x_inc'} = 2;
230 4         8 $self->{'x_inc_factor'} = 4; # ((x+2)^2 - x^2) = 4*x+4
231 4         7 $self->{'x_inc_squared'} = 4;
232 4         7 $self->{'skip_parity'} = 1;
233 4         9 $self->{'symmetry'} = 12;
234              
235             } elsif ($points eq 'odd') {
236 2         7 $self->{'n_to_x'} = [];
237 2         7 $self->{'n_to_y'} = [];
238 2         6 $self->{'hypot_to_n'} = [];
239 2         6 $self->{'y_next_x'} = [1-2];
240 2         8 $self->{'y_next_hypot'} = [1];
241 2         8 $self->{'x_inc'} = 2;
242 2         5 $self->{'x_inc_factor'} = 4;
243 2         5 $self->{'x_inc_squared'} = 4;
244 2         5 $self->{'skip_parity'} = 0;
245 2         4 $self->{'symmetry'} = 4;
246              
247             } elsif ($points eq 'hex') {
248 2         7 $self->{'n_to_x'} = [0]; # N=0 at X=0,Y=0
249 2         6 $self->{'n_to_y'} = [0];
250 2         7 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
251 2         7 $self->{'y_next_x'} = [2-2];
252 2         5 $self->{'y_next_hypot'} = [2**2 + 3*0**2]; # next at X=2,Y=0
253 2         7 $self->{'x_inc'} = 2;
254 2         4 $self->{'x_inc_factor'} = 4; # ((x+2)^2 - x^2) = 4*x+4
255 2         5 $self->{'x_inc_squared'} = 4;
256 2         3 $self->{'skip_parity'} = 1; # should be even
257 2         4 $self->{'skip_hex'} = 4; # x+3y==0,2 only
258 2         6 $self->{'symmetry'} = 6;
259              
260             } elsif ($points eq 'hex_rotated') {
261 1         5 $self->{'n_to_x'} = [0]; # N=0 at X=0,Y=0
262 1         3 $self->{'n_to_y'} = [0];
263 1         2 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
264 1         3 $self->{'y_next_x'} = [4-2,
265             1-2];
266 1         3 $self->{'y_next_hypot'} = [4**2 + 3*0**2, # next at X=4,Y=0
267             1**2 + 3*1**2]; # next at X=1,Y=1
268 1         4 $self->{'x_inc'} = 2;
269 1         3 $self->{'x_inc_factor'} = 4; # ((x+2)^2 - x^2) = 4*x+4
270 1         3 $self->{'x_inc_squared'} = 4;
271 1         3 $self->{'skip_parity'} = 1; # should be even
272 1         2 $self->{'skip_hex'} = 2; # x+3y==0,4 only
273 1         3 $self->{'symmetry'} = 6;
274              
275             } elsif ($points eq 'hex_centred') {
276 2         5 $self->{'n_to_x'} = [];
277 2         5 $self->{'n_to_y'} = [];
278 2         5 $self->{'hypot_to_n'} = [];
279 2         5 $self->{'y_next_x'} = [2-2]; # for first at X=2
280 2         6 $self->{'y_next_hypot'} = [2**2 + 3*0**2]; # at X=2,Y=0
281 2         6 $self->{'x_inc'} = 2;
282 2         4 $self->{'x_inc_factor'} = 4; # ((x+2)^2 - x^2) = 4*x+4
283 2         4 $self->{'x_inc_squared'} = 4;
284 2         3 $self->{'skip_parity'} = 1; # should be even
285 2         4 $self->{'skip_hex'} = 0; # x+3y==2,4 only
286 2         4 $self->{'symmetry'} = 12;
287              
288             } else {
289 0         0 croak "Unrecognised points option: ", $points;
290             }
291              
292             ### $self
293             ### assert: $self->{'y_next_hypot'}->[0] == (3 * 0**2 + ($self->{'y_next_x'}->[0]+$self->{'x_inc'})**2)
294              
295 13         29 return $self;
296             }
297              
298             sub _extend {
299 3724     3724   5602 my ($self) = @_;
300             ### _extend() ...
301              
302 3724         5263 my $n_to_x = $self->{'n_to_x'};
303 3724         4882 my $n_to_y = $self->{'n_to_y'};
304 3724         5473 my $hypot_to_n = $self->{'hypot_to_n'};
305 3724         5519 my $y_next_x = $self->{'y_next_x'};
306 3724         5155 my $y_next_hypot = $self->{'y_next_hypot'};
307              
308             ### $y_next_x
309             ### $y_next_hypot
310              
311             # set @y to the Y with the smallest $y_next_hypot->[$y], and if there's some
312             # Y's with equal smallest hypot then all those Y's in ascending order
313 3724         5622 my @y = (0);
314 3724         5206 my $hypot = $y_next_hypot->[0];
315 3724         7405 for (my $i = 1; $i < @$y_next_x; $i++) {
316 85696 100       202460 if ($hypot == $y_next_hypot->[$i]) {
    100          
317 2443         5082 push @y, $i;
318             } elsif ($hypot > $y_next_hypot->[$i]) {
319 7689         11964 @y = ($i);
320 7689         14641 $hypot = $y_next_hypot->[$i];
321             }
322             }
323              
324             ### chosen y list: @y
325              
326             # if the endmost of the @$y_next_x, @y_next_hypot arrays are used then
327             # extend them by one
328 3724 100       7171 if ($y[-1] == $#$y_next_x) {
329 259         438 my $y = scalar(@$y_next_x); # new Y value
330              
331             ### highest y: $y[-1]
332             ### so grow y: $y
333              
334 259         489 my $points = $self->{'points'};
335 259 100       745 if ($points eq 'even') {
    100          
    100          
    100          
    100          
336             # h = (3 * $y**2 + $x**2)
337             # = (3 * $y**2 + ($3*y)**2)
338             # = (3*$y*$y + 9*$y*$y)
339             # = (12*$y*$y)
340 28         66 $y_next_x->[$y] = 3*$y - $self->{'x_inc'}; # X=3*Y, so X-2=3*Y-2
341 28         57 $y_next_hypot->[$y] = 12*$y*$y;
342              
343             } elsif ($points eq 'odd') {
344 55         105 my $odd = ! ($y%2);
345 55         120 $y_next_x->[$y] = $odd - $self->{'x_inc'};
346 55         115 $y_next_hypot->[$y] = 3*$y*$y + $odd;
347              
348             } elsif ($points eq 'hex') {
349 56 100       145 my $x = $y_next_x->[$y] = (($y % 3) == 1 ? $y : $y-2);
350 56         85 $x += 2;
351 56         124 $y_next_hypot->[$y] = $x*$x + 3*$y*$y;
352             ### assert: (($x+$y*3) % 6 == 0 || ($x+$y*3) % 6 == 2)
353              
354             } elsif ($points eq 'hex_rotated') {
355 45 100       149 my $x = $y_next_x->[$y] = (($y % 3) == 2 ? $y : $y-2);
356 45         66 $x += 2;
357 45         98 $y_next_hypot->[$y] = $x*$x + 3*$y*$y;
358             ### assert: (($x+$y*3) % 6 == 4 || ($x+$y*3) % 6 == 0)
359              
360             } elsif ($points eq 'hex_centred') {
361 32         66 my $x = $y_next_x->[$y] = 3*$y;
362 32         45 $x += 2;
363 32         72 $y_next_hypot->[$y] = $x*$x + 3*$y*$y;
364             ### assert: (($x+$y*3) % 6 == 2 || ($x+$y*3) % 6 == 4)
365              
366             } else {
367             ### assert: $points eq 'all'
368 43         103 $y_next_x->[$y] = - $self->{'x_inc'}; # X=0, so X-1=0
369 43         93 $y_next_hypot->[$y] = 3*$y*$y;
370             }
371              
372             ### new y_next_x (with adjustment): $y_next_x->[$y]+$self->{'x_inc'}
373             ### new y_next_hypot: $y_next_hypot->[$y]
374              
375             ### assert: ($points ne 'even' || (($y ^ ($y_next_x->[$y]+$self->{'x_inc'})) & 1) == 0)
376             ### assert: $y_next_hypot->[$y] == (3 * $y**2 + ($y_next_x->[$y]+$self->{'x_inc'})**2)
377             }
378              
379             # @x is the $y_next_x->[$y] for each of the @y smallests, and step those
380             # selected elements next X and hypot for that new X,Y
381             my @x = map {
382             ### assert: (3 * $_**2 + ($y_next_x->[$_]+$self->{'x_inc'})**2) == $y_next_hypot->[$_]
383              
384 3724         6397 my $x = ($y_next_x->[$_] += $self->{'x_inc'});
  5580         8994  
385             ### map y _: $_
386             ### map inc x to: $x
387 5580 100 100     14257 if (defined $self->{'skip_hex'}
388             && ($x+2 + 3*$_) % 6 == $self->{'skip_hex'}) {
389             ### extra inc for hex ...
390 1110         1623 $y_next_x->[$_] += 2;
391 1110         1772 $y_next_hypot->[$_] += 8*$x+16; # (X+4)^2-X^2 = 8X+16
392             } else {
393             $y_next_hypot->[$_]
394 4470         7504 += $self->{'x_inc_factor'}*$x + $self->{'x_inc_squared'};
395             }
396              
397             ### $x
398             ### y_next_x (including adjust): $y_next_x->[$_]+$self->{'x_inc'}
399             ### y_next_hypot[]: $y_next_hypot->[$_]
400              
401             ### assert: $y_next_hypot->[$_] == (3 * $_**2 + ($y_next_x->[$_]+$self->{'x_inc'})**2)
402             ### assert: $self->{'points'} ne 'hex' || (($x+3*$_) % 6 == 0 || ($x+3*$_) % 6 == 2)
403             ### assert: $self->{'points'} ne 'hex_rotated' || (($x+$_*3) % 6 == 4 || ($x+$_*3) % 6 == 0)
404             ### assert: $self->{'points'} ne 'hex_centred' || (($x+$_*3) % 6 == 2 || ($x+$_*3) % 6 == 4)
405              
406 5580         10933 $x
407             } @y;
408             ### $hypot
409              
410 3724         5259 my $p2;
411 3724 100       7694 if ($self->{'symmetry'} == 12) {
    100          
412             ### base twelvth: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
413 765         1219 my $p1 = scalar(@y);
414 765         1209 my @base_x = @x;
415 765         1165 my @base_y = @y;
416 765 100       1378 unless ($y[0]) { # no mirror of x,0
417 84         135 shift @base_x;
418 84         123 shift @base_y;
419             }
420 765 100       1444 if ($x[-1] == 3*$y[-1]) { # no mirror of x=3*y line
421 26         43 pop @base_x;
422 26         45 pop @base_y;
423             }
424 765         2847 $#x = $#y = ($p1+scalar(@base_x))*6-1; # pre-extend arrays
425 765         1750 for (my $i = $#base_x; $i >= 0; $i--) {
426 830         1679 $x[$p1] = ($base_x[$i] + 3*$base_y[$i]) / 2;
427 830         1960 $y[$p1++] = ($base_x[$i] - $base_y[$i]) / 2;
428             }
429             ### with mirror 30: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p1-1)
430              
431 765         1121 $p2 = 2*$p1;
432 765         1483 foreach my $i (0 .. $p1-1) {
433 1770         3354 $x[$p1] = ($x[$i] - 3*$y[$i])/2; # rotate +60
434 1770         2831 $y[$p1++] = ($x[$i] + $y[$i])/2;
435              
436 1770         2828 $x[$p2] = ($x[$i] + 3*$y[$i])/-2; # rotate +120
437 1770         3225 $y[$p2++] = ($x[$i] - $y[$i])/2;
438             }
439             ### with rotates 60,120: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p2-1)
440              
441 765         1270 foreach my $i (0 .. $p2-1) {
442 5310         7816 $x[$p2] = -$x[$i]; # rotate 180
443 5310         8920 $y[$p2++] = -$y[$i];
444             }
445             ### with rotate 180: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
446              
447             } elsif ($self->{'symmetry'} == 6) {
448 1106         1669 my $p1 = scalar(@x);
449 1106         1760 my @base_x = @x;
450 1106         1690 my @base_y = @y;
451 1106 100       2028 unless ($y[0]) { # no mirror of x,0
452 67         96 shift @base_x;
453 67         106 shift @base_y;
454             }
455 1106 100       1981 if ($x[-1] == $y[-1]) { # no mirror of X=Y line
456 66         100 pop @base_x;
457 66         101 pop @base_y;
458             }
459             ### base xy: join(' ',map{"$base_x[$_],$base_y[$_]"} 0 .. $#base_x)
460              
461 1106         2286 for (my $i = $#base_x; $i >= 0; $i--) {
462 1642         3056 $x[$p1] = ($base_x[$i] - 3*$base_y[$i]) / -2; # mirror +60
463 1642         3700 $y[$p1++] = ($base_x[$i] + $base_y[$i]) / 2;
464             }
465             ### with mirror 60: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p1-1)
466              
467 1106         1521 $p2 = 2*$p1;
468 1106         2566 foreach my $i (0 .. $#x) {
469 3417         6137 $x[$p1] = ($x[$i] + 3*$y[$i])/-2; # rotate +120
470 3417         5527 $y[$p1++] = ($x[$i] - $y[$i])/2;
471              
472 3417         5217 $x[$p2] = ($x[$i] - 3*$y[$i])/-2; # rotate +240 == -120
473 3417         6367 $y[$p2++] = ($x[$i] + $y[$i])/-2;
474              
475             # should be on correct grid
476             # ### assert: (($x[$p1-1]+$y[$p1-1]*3) % 6 == 0 || ($x[$p1-1]+$y[$p1-1]*3) % 6 == 2)
477             # ### assert: (($x[$p2-1]+$y[$p2-1]*3) % 6 == 0 || ($x[$p2-1]+$y[$p2-1]*3) % 6 == 2)
478             }
479             ### with rotates 120,240: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p2-1)
480              
481             } else {
482             ### assert: $self->{'symmetry'} == 4
483             ### base quarter: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
484 1853         2658 my $p1 = $#x;
485 1853         2968 push @y, reverse @y;
486 1853         3045 push @x, map {-$_} reverse @x;
  2865         4832  
487 1853 100       3707 if ($x[$p1] == 0) {
488 68         131 splice @x, $p1, 1; # don't duplicate X=0 in mirror
489 68         103 splice @y, $p1, 1;
490             }
491 1853 100       3342 if ($y[-1] == 0) {
492 119         178 pop @y; # omit final Y=0 ready for rotate
493 119         169 pop @x;
494             }
495 1853         2654 $p2 = scalar(@y);
496             ### with mirror +90: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p2-1)
497              
498 1853         3805 foreach my $i (0 .. $p2-1) {
499 5543         8400 $x[$p2] = -$x[$i]; # rotate 180
500 5543         9445 $y[$p2++] = -$y[$i];
501             }
502             ### with rotate 180: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
503             }
504              
505             ### store: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
506             ### at n: scalar(@$n_to_x)
507             ### hypot_to_n: "h=$hypot n=".scalar(@$n_to_x)
508 3724         7812 $hypot_to_n->[$hypot] = scalar(@$n_to_x);
509 3724         9917 push @$n_to_x, @x;
510 3724         15556 push @$n_to_y, @y;
511              
512             # ### hypot_to_n now: join(' ',map {defined($hypot_to_n->[$_]) && "h=$_,n=$hypot_to_n->[$_]"} 0 .. $#hypot_to_n)
513             }
514              
515             sub n_to_xy {
516 29994     29994 1 387933 my ($self, $n) = @_;
517             ### TriangularHypot n_to_xy(): $n
518              
519 29994         43370 $n = $n - $self->{'n_start'}; # starting $n==0, warn if $n==undef
520 29994 50       52796 if ($n < 0) { return; }
  0         0  
521 29994 50       53971 if (is_infinite($n)) { return ($n,$n); }
  0         0  
522              
523 29994         50328 my $int = int($n);
524 29994         38899 $n -= $int; # fraction part
525              
526 29994         42061 my $n_to_x = $self->{'n_to_x'};
527 29994         41140 my $n_to_y = $self->{'n_to_y'};
528              
529 29994         59547 while ($int >= $#$n_to_x) {
530 3425         5951 _extend($self);
531             }
532              
533 29994         45295 my $x = $n_to_x->[$int];
534 29994         41491 my $y = $n_to_y->[$int];
535 29994         77350 return ($x + $n * ($n_to_x->[$int+1] - $x),
536             $y + $n * ($n_to_y->[$int+1] - $y));
537             }
538              
539             sub xy_is_visited {
540 0     0 1 0 my ($self, $x, $y) = @_;
541              
542 0 0       0 if (defined $self->{'skip_parity'}) {
543 0         0 $x = round_nearest ($x);
544 0         0 $y = round_nearest ($y);
545 0 0       0 if ((($x%2) ^ ($y%2)) == $self->{'skip_parity'}) {
546             ### XY wrong parity, no point ...
547 0         0 return 0;
548             }
549             }
550 0 0       0 if (defined $self->{'skip_hex'}) {
551 0         0 $x = round_nearest ($x);
552 0         0 $y = round_nearest ($y);
553 0 0       0 if ((($x%6) + 3*($y%6)) % 6 == $self->{'skip_hex'}) {
554             ### XY wrong hex, no point ...
555 0         0 return 0;
556             }
557             }
558 0         0 return 1;
559             }
560              
561             sub xy_to_n {
562 2205     2205 1 25634 my ($self, $x, $y) = @_;
563             ### TriangularHypot xy_to_n(): "$x, $y points=$self->{'points'}"
564              
565 2205         3943 $x = round_nearest ($x);
566 2205         4117 $y = round_nearest ($y);
567              
568             ### parity xor: ($x%2) ^ ($y%2)
569             ### hex modulo: (($x%6) + 3*($y%6)) % 6
570 2205 100 100     7037 if (defined $self->{'skip_parity'}
571             && (($x%2) ^ ($y%2)) == $self->{'skip_parity'}) {
572             ### XY wrong parity, no point ...
573 881         1750 return undef;
574             }
575 1324 100 100     3100 if (defined $self->{'skip_hex'}
576             && (($x%6) + 3*($y%6)) % 6 == $self->{'skip_hex'}) {
577             ### XY wrong hex, no point ...
578 147         338 return undef;
579             }
580              
581              
582 1177         1866 my $hypot = 3*$y*$y + $x*$x;
583 1177 50       2113 if (is_infinite($hypot)) {
584             # avoid infinite loop extending @hypot_to_n
585 0         0 return undef;
586             }
587             ### $hypot
588              
589 1177         2141 my $hypot_to_n = $self->{'hypot_to_n'};
590 1177         1550 my $n_to_x = $self->{'n_to_x'};
591 1177         1691 my $n_to_y = $self->{'n_to_y'};
592              
593 1177         2325 while ($hypot > $#$hypot_to_n) {
594 299         523 _extend($self);
595             }
596 1177         1793 my $n = $hypot_to_n->[$hypot];
597 1177         1534 for (;;) {
598 5355 100 100     11645 if ($x == $n_to_x->[$n] && $y == $n_to_y->[$n]) {
599 1177         2756 return $n + $self->{'n_start'};
600             }
601 4178         5282 $n += 1;
602              
603 4178 50       8947 if ($n_to_x->[$n]**2 + 3*$n_to_y->[$n]**2 != $hypot) {
604             ### oops, hypot_to_n no good ...
605 0         0 return undef;
606             }
607             }
608             }
609              
610             # not exact
611             sub rect_to_n_range {
612 5     5 1 54 my ($self, $x1,$y1, $x2,$y2) = @_;
613              
614 5         15 $x1 = abs (round_nearest ($x1));
615 5         12 $y1 = abs (round_nearest ($y1));
616 5         14 $x2 = abs (round_nearest ($x2));
617 5         12 $y2 = abs (round_nearest ($y2));
618              
619 5 50       12 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
  0         0  
620 5 50       12 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); }
  0         0  
621              
622             # xyradius r^2 = 1/4 * $x2**2 + 3/4 * $y2**2
623             # (r+1/2)^2 = r^2 + r + 1/4
624             # circlearea = pi*(r+1/2)^2
625             # each hexagon area outradius 1/2 is hexarea = sqrt(27/64)
626              
627 5         12 my $r2 = $x2*$x2 + 3*$y2*$y2;
628             my $n = (3.15 / sqrt(27/64) / 4) * ($r2 + sqrt($r2))
629 5         18 * (3 - $self->{'x_inc'}); # *2 for odd or even, *1 for all
630             return ($self->{'n_start'},
631 5         18 $self->{'n_start'} + int($n));
632             }
633              
634             1;
635             __END__