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, 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             # 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   1575 use 5.004;
  1         4  
74 1     1   6 use strict;
  1         2  
  1         22  
75 1     1   5 use Carp 'croak';
  1         3  
  1         47  
76              
77 1     1   6 use vars '$VERSION', '@ISA';
  1         1  
  1         73  
78             $VERSION = 129;
79 1     1   800 use Math::PlanePath;
  1         3  
  1         42  
80             @ISA = ('Math::PlanePath');
81              
82             use Math::PlanePath::Base::Generic
83 1         74 'is_infinite',
84 1     1   7 'round_nearest';
  1         1  
85              
86             # uncomment this to run the ### lines
87             # use Smart::Comments;
88              
89              
90 1         2824 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 4764 my $self = shift->SUPER::new(@_);
206              
207 13 50       58 if (! defined $self->{'n_start'}) {
208 13         64 $self->{'n_start'} = $self->default_n_start;
209             }
210              
211 13   100     50 my $points = ($self->{'points'} ||= 'even');
212 13 100       73 if ($points eq 'all') {
    100          
    100          
    100          
    100          
    50          
213 2         6 $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         5 $self->{'y_next_x'} = [1-1];
217 2         6 $self->{'y_next_hypot'} = [3*0**2 + 1**2];
218 2         8 $self->{'x_inc'} = 1;
219 2         4 $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         12 $self->{'n_to_x'} = [0];
225 4         9 $self->{'n_to_y'} = [0];
226 4         9 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
227 4         9 $self->{'y_next_x'} = [2-2];
228 4         9 $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         8 $self->{'x_inc_squared'} = 4;
232 4         6 $self->{'skip_parity'} = 1;
233 4         8 $self->{'symmetry'} = 12;
234              
235             } elsif ($points eq 'odd') {
236 2         6 $self->{'n_to_x'} = [];
237 2         5 $self->{'n_to_y'} = [];
238 2         4 $self->{'hypot_to_n'} = [];
239 2         6 $self->{'y_next_x'} = [1-2];
240 2         6 $self->{'y_next_hypot'} = [1];
241 2         8 $self->{'x_inc'} = 2;
242 2         4 $self->{'x_inc_factor'} = 4;
243 2         5 $self->{'x_inc_squared'} = 4;
244 2         4 $self->{'skip_parity'} = 0;
245 2         5 $self->{'symmetry'} = 4;
246              
247             } elsif ($points eq 'hex') {
248 2         6 $self->{'n_to_x'} = [0]; # N=0 at X=0,Y=0
249 2         6 $self->{'n_to_y'} = [0];
250 2         5 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
251 2         5 $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         4 $self->{'skip_parity'} = 1; # should be even
257 2         6 $self->{'skip_hex'} = 4; # x+3y==0,2 only
258 2         6 $self->{'symmetry'} = 6;
259              
260             } elsif ($points eq 'hex_rotated') {
261 1         3 $self->{'n_to_x'} = [0]; # N=0 at X=0,Y=0
262 1         2 $self->{'n_to_y'} = [0];
263 1         3 $self->{'hypot_to_n'} = [0]; # N=0 at X=0,Y=0
264 1         2 $self->{'y_next_x'} = [4-2,
265             1-2];
266 1         2 $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         2 $self->{'x_inc_factor'} = 4; # ((x+2)^2 - x^2) = 4*x+4
270 1         2 $self->{'x_inc_squared'} = 4;
271 1         2 $self->{'skip_parity'} = 1; # should be even
272 1         2 $self->{'skip_hex'} = 2; # x+3y==0,4 only
273 1         2 $self->{'symmetry'} = 6;
274              
275             } elsif ($points eq 'hex_centred') {
276 2         6 $self->{'n_to_x'} = [];
277 2         5 $self->{'n_to_y'} = [];
278 2         4 $self->{'hypot_to_n'} = [];
279 2         5 $self->{'y_next_x'} = [2-2]; # for first at X=2
280 2         5 $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         5 $self->{'skip_hex'} = 0; # x+3y==2,4 only
286 2         3 $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         32 return $self;
296             }
297              
298             sub _extend {
299 3724     3724   5916 my ($self) = @_;
300             ### _extend() ...
301              
302 3724         5401 my $n_to_x = $self->{'n_to_x'};
303 3724         5190 my $n_to_y = $self->{'n_to_y'};
304 3724         5051 my $hypot_to_n = $self->{'hypot_to_n'};
305 3724         5089 my $y_next_x = $self->{'y_next_x'};
306 3724         4984 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         5482 my @y = (0);
314 3724         5129 my $hypot = $y_next_hypot->[0];
315 3724         7377 for (my $i = 1; $i < @$y_next_x; $i++) {
316 85696 100       198374 if ($hypot == $y_next_hypot->[$i]) {
    100          
317 2443         4949 push @y, $i;
318             } elsif ($hypot > $y_next_hypot->[$i]) {
319 7689         11769 @y = ($i);
320 7689         14947 $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       6984 if ($y[-1] == $#$y_next_x) {
329 259         377 my $y = scalar(@$y_next_x); # new Y value
330              
331             ### highest y: $y[-1]
332             ### so grow y: $y
333              
334 259         444 my $points = $self->{'points'};
335 259 100       697 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         60 $y_next_x->[$y] = 3*$y - $self->{'x_inc'}; # X=3*Y, so X-2=3*Y-2
341 28         66 $y_next_hypot->[$y] = 12*$y*$y;
342              
343             } elsif ($points eq 'odd') {
344 55         113 my $odd = ! ($y%2);
345 55         108 $y_next_x->[$y] = $odd - $self->{'x_inc'};
346 55         120 $y_next_hypot->[$y] = 3*$y*$y + $odd;
347              
348             } elsif ($points eq 'hex') {
349 56 100       159 my $x = $y_next_x->[$y] = (($y % 3) == 1 ? $y : $y-2);
350 56         75 $x += 2;
351 56         121 $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       199 my $x = $y_next_x->[$y] = (($y % 3) == 2 ? $y : $y-2);
356 45         72 $x += 2;
357 45         88 $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         71 my $x = $y_next_x->[$y] = 3*$y;
362 32         43 $x += 2;
363 32         71 $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         92 $y_next_x->[$y] = - $self->{'x_inc'}; # X=0, so X-1=0
369 43         83 $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         6513 my $x = ($y_next_x->[$_] += $self->{'x_inc'});
  5580         8790  
385             ### map y _: $_
386             ### map inc x to: $x
387 5580 100 100     14172 if (defined $self->{'skip_hex'}
388             && ($x+2 + 3*$_) % 6 == $self->{'skip_hex'}) {
389             ### extra inc for hex ...
390 1110         1656 $y_next_x->[$_] += 2;
391 1110         1595 $y_next_hypot->[$_] += 8*$x+16; # (X+4)^2-X^2 = 8X+16
392             } else {
393             $y_next_hypot->[$_]
394 4470         7448 += $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         11880 $x
407             } @y;
408             ### $hypot
409              
410 3724         5434 my $p2;
411 3724 100       7509 if ($self->{'symmetry'} == 12) {
    100          
412             ### base twelvth: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
413 765         1089 my $p1 = scalar(@y);
414 765         1307 my @base_x = @x;
415 765         1169 my @base_y = @y;
416 765 100       1365 unless ($y[0]) { # no mirror of x,0
417 84         121 shift @base_x;
418 84         121 shift @base_y;
419             }
420 765 100       1424 if ($x[-1] == 3*$y[-1]) { # no mirror of x=3*y line
421 26         46 pop @base_x;
422 26         39 pop @base_y;
423             }
424 765         2592 $#x = $#y = ($p1+scalar(@base_x))*6-1; # pre-extend arrays
425 765         1802 for (my $i = $#base_x; $i >= 0; $i--) {
426 830         1724 $x[$p1] = ($base_x[$i] + 3*$base_y[$i]) / 2;
427 830         2013 $y[$p1++] = ($base_x[$i] - $base_y[$i]) / 2;
428             }
429             ### with mirror 30: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p1-1)
430              
431 765         1077 $p2 = 2*$p1;
432 765         1492 foreach my $i (0 .. $p1-1) {
433 1770         3424 $x[$p1] = ($x[$i] - 3*$y[$i])/2; # rotate +60
434 1770         2940 $y[$p1++] = ($x[$i] + $y[$i])/2;
435              
436 1770         2801 $x[$p2] = ($x[$i] + 3*$y[$i])/-2; # rotate +120
437 1770         3158 $y[$p2++] = ($x[$i] - $y[$i])/2;
438             }
439             ### with rotates 60,120: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p2-1)
440              
441 765         1343 foreach my $i (0 .. $p2-1) {
442 5310         8312 $x[$p2] = -$x[$i]; # rotate 180
443 5310         9021 $y[$p2++] = -$y[$i];
444             }
445             ### with rotate 180: join(' ',map{"$x[$_],$y[$_]"} 0 .. $#x)
446              
447             } elsif ($self->{'symmetry'} == 6) {
448 1106         1746 my $p1 = scalar(@x);
449 1106         1853 my @base_x = @x;
450 1106         1761 my @base_y = @y;
451 1106 100       1985 unless ($y[0]) { # no mirror of x,0
452 67         107 shift @base_x;
453 67         93 shift @base_y;
454             }
455 1106 100       2150 if ($x[-1] == $y[-1]) { # no mirror of X=Y line
456 66         84 pop @base_x;
457 66         98 pop @base_y;
458             }
459             ### base xy: join(' ',map{"$base_x[$_],$base_y[$_]"} 0 .. $#base_x)
460              
461 1106         2526 for (my $i = $#base_x; $i >= 0; $i--) {
462 1642         3648 $x[$p1] = ($base_x[$i] - 3*$base_y[$i]) / -2; # mirror +60
463 1642         3753 $y[$p1++] = ($base_x[$i] + $base_y[$i]) / 2;
464             }
465             ### with mirror 60: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p1-1)
466              
467 1106         1543 $p2 = 2*$p1;
468 1106         2151 foreach my $i (0 .. $#x) {
469 3417         6299 $x[$p1] = ($x[$i] + 3*$y[$i])/-2; # rotate +120
470 3417         5559 $y[$p1++] = ($x[$i] - $y[$i])/2;
471              
472 3417         5402 $x[$p2] = ($x[$i] - 3*$y[$i])/-2; # rotate +240 == -120
473 3417         6373 $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         2789 my $p1 = $#x;
485 1853         3433 push @y, reverse @y;
486 1853         2872 push @x, map {-$_} reverse @x;
  2865         4905  
487 1853 100       3809 if ($x[$p1] == 0) {
488 68         138 splice @x, $p1, 1; # don't duplicate X=0 in mirror
489 68         108 splice @y, $p1, 1;
490             }
491 1853 100       3348 if ($y[-1] == 0) {
492 119         165 pop @y; # omit final Y=0 ready for rotate
493 119         164 pop @x;
494             }
495 1853         2627 $p2 = scalar(@y);
496             ### with mirror +90: join(' ',map{"$x[$_],$y[$_]"} 0 .. $p2-1)
497              
498 1853         3803 foreach my $i (0 .. $p2-1) {
499 5543         8160 $x[$p2] = -$x[$i]; # rotate 180
500 5543         9134 $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         8442 $hypot_to_n->[$hypot] = scalar(@$n_to_x);
509 3724         10069 push @$n_to_x, @x;
510 3724         15738 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 404866 my ($self, $n) = @_;
517             ### TriangularHypot n_to_xy(): $n
518              
519 29994         43336 $n = $n - $self->{'n_start'}; # starting $n==0, warn if $n==undef
520 29994 50       53239 if ($n < 0) { return; }
  0         0  
521 29994 50       55196 if (is_infinite($n)) { return ($n,$n); }
  0         0  
522              
523 29994         51386 my $int = int($n);
524 29994         40882 $n -= $int; # fraction part
525              
526 29994         42619 my $n_to_x = $self->{'n_to_x'};
527 29994         40516 my $n_to_y = $self->{'n_to_y'};
528              
529 29994         56939 while ($int >= $#$n_to_x) {
530 3425         6082 _extend($self);
531             }
532              
533 29994         45423 my $x = $n_to_x->[$int];
534 29994         41982 my $y = $n_to_y->[$int];
535 29994         79405 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 26429 my ($self, $x, $y) = @_;
563             ### TriangularHypot xy_to_n(): "$x, $y points=$self->{'points'}"
564              
565 2205         4268 $x = round_nearest ($x);
566 2205         4127 $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     6881 if (defined $self->{'skip_parity'}
571             && (($x%2) ^ ($y%2)) == $self->{'skip_parity'}) {
572             ### XY wrong parity, no point ...
573 881         1804 return undef;
574             }
575 1324 100 100     3129 if (defined $self->{'skip_hex'}
576             && (($x%6) + 3*($y%6)) % 6 == $self->{'skip_hex'}) {
577             ### XY wrong hex, no point ...
578 147         288 return undef;
579             }
580              
581              
582 1177         1749 my $hypot = 3*$y*$y + $x*$x;
583 1177 50       2194 if (is_infinite($hypot)) {
584             # avoid infinite loop extending @hypot_to_n
585 0         0 return undef;
586             }
587             ### $hypot
588              
589 1177         2149 my $hypot_to_n = $self->{'hypot_to_n'};
590 1177         1631 my $n_to_x = $self->{'n_to_x'};
591 1177         1672 my $n_to_y = $self->{'n_to_y'};
592              
593 1177         2701 while ($hypot > $#$hypot_to_n) {
594 299         551 _extend($self);
595             }
596 1177         1805 my $n = $hypot_to_n->[$hypot];
597 1177         1642 for (;;) {
598 5355 100 100     11593 if ($x == $n_to_x->[$n] && $y == $n_to_y->[$n]) {
599 1177         2772 return $n + $self->{'n_start'};
600             }
601 4178         5629 $n += 1;
602              
603 4178 50       8421 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 47 my ($self, $x1,$y1, $x2,$y2) = @_;
613              
614 5         13 $x1 = abs (round_nearest ($x1));
615 5         10 $y1 = abs (round_nearest ($y1));
616 5         13 $x2 = abs (round_nearest ($x2));
617 5         11 $y2 = abs (round_nearest ($y2));
618              
619 5 50       12 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
  0         0  
620 5 50       10 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         9 my $r2 = $x2*$x2 + 3*$y2*$y2;
628             my $n = (3.15 / sqrt(27/64) / 4) * ($r2 + sqrt($r2))
629 5         15 * (3 - $self->{'x_inc'}); # *2 for odd or even, *1 for all
630             return ($self->{'n_start'},
631 5         16 $self->{'n_start'} + int($n));
632             }
633              
634             1;
635             __END__