File Coverage

blib/lib/Math/PlanePath/HexArms.pm
Criterion Covered Total %
statement 111 113 98.2
branch 20 22 90.9
condition 3 3 100.0
subroutine 23 23 100.0
pod 3 3 100.0
total 160 164 97.5


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 it
6             # under the terms of the GNU General Public License as published by the Free
7             # 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=HexArms --lines --scale=10
20             # math-image --path=HexArms --all --output=numbers_dash
21             # math-image --path=HexArms --values=Polygonal,polygonal=8
22              
23             # Abundant: A005101
24             # octagonal numbers ...
25             # 26-gonal near vertical x2
26             # 152 near horizontal
27             #
28             # 2
29             # 164 +162
30             # 542 +378 +216
31             # 1136 +594 +216
32             #
33              
34             package Math::PlanePath::HexArms;
35 1     1   9927 use 5.004;
  1         10  
36 1     1   5 use strict;
  1         2  
  1         49  
37             #use List::Util 'max';
38             *max = \&Math::PlanePath::_max;
39              
40 1     1   5 use vars '$VERSION', '@ISA';
  1         4  
  1         84  
41             $VERSION = 129;
42 1     1   773 use Math::PlanePath;
  1         2  
  1         63  
43             @ISA = ('Math::PlanePath');
44             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
45             *_sqrtint = \&Math::PlanePath::_sqrtint;
46              
47             use Math::PlanePath::Base::Generic
48 1     1   6 'round_nearest';
  1         2  
  1         41  
49              
50             # uncomment this to run the ### lines
51             #use Devel::Comments '###';
52              
53              
54 1     1   5 use constant arms_count => 6;
  1         2  
  1         59  
55             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_even;
56              
57 1     1   5 use constant x_negative_at_n => 4;
  1         2  
  1         42  
58 1     1   5 use constant y_negative_at_n => 6;
  1         2  
  1         40  
59 1     1   5 use constant dx_minimum => -2;
  1         2  
  1         91  
60 1     1   8 use constant dx_maximum => 2;
  1         2  
  1         103  
61 1     1   9 use constant dy_minimum => -1;
  1         2  
  1         46  
62 1     1   6 use constant dy_maximum => 1;
  1         1  
  1         69  
63             *_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::_UNDOCUMENTED__dxdy_list_six;
64 1     1   7 use constant absdx_minimum => 1;
  1         1  
  1         46  
65 1     1   5 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         49  
66 1     1   7 use constant dsumxy_maximum => 2;
  1         1  
  1         57  
67 1     1   6 use constant ddiffxy_minimum => -2;
  1         1  
  1         51  
68 1     1   6 use constant ddiffxy_maximum => 2;
  1         1  
  1         44  
69 1     1   5 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         1  
  1         58  
70 1     1   6 use constant turn_any_right => 0; # only left or straight
  1         2  
  1         615  
71              
72              
73             #------------------------------------------------------------------------------
74              
75             # [ 0, 1, 2, 3,],
76             # [ 0, 1, 3, 6 ],
77             # N = (1/2 d^2 + 1/2 d)
78             # d = -1/2 + sqrt(2 * $n + 1/4)
79             # = (-1 + 2*sqrt(2 * $n + 1/4)) / 2
80             # = (-1 + sqrt(8 * $n + 1)) / 2
81              
82             sub n_to_xy {
83 24     24 1 2460 my ($self, $n) = @_;
84             #### HexArms n_to_xy: $n
85              
86 24 100       59 if ($n < 2) {
87 2 50       5 if ($n < 1) { return; }
  0         0  
88             ### centre
89 2         3 $n--;
90 2         7 return ($n, -$n); # from n=1 towards n=7 at x=1,y=-1
91             }
92 22         36 $n -= 2;
93              
94 22         27 my $frac;
95 22         33 { my $int = int($n);
  22         32  
96 22         28 $frac = $n - $int;
97 22         33 $n = $int; # BigFloat int() gives BigInt, use that
98             }
99              
100             # arm as initial rotation
101 22         50 my $rot = _divrem_mutate($n,6);
102             ### $n
103              
104 22         57 my $d = int ((-1 + _sqrtint(8 * $n + 1)) / 2);
105             ### d frac: ((-1 + _sqrtint(8 * $n + 1)) / 2)
106             ### $d
107             ### base: $d*($d+1)/2
108              
109 22         41 $n -= $d*($d+1)/2;
110             ### remainder: $n
111             ### assert: $n <= $d
112              
113 22         32 $rot += ($d % 6);
114 22         32 my $x = $frac + 2 + $d + $n;
115 22         33 my $y = $frac - $d + $n;
116              
117 22         29 $rot %= 6;
118 22 100       41 if ($rot >= 3) {
119 11         16 $rot -= 3;
120 11         16 $x = -$x; # rotate 180
121 11         15 $y = -$y;
122             }
123 22 100       47 if ($rot == 0) {
    100          
124 8         20 return ($x,$y);
125             } elsif ($rot == 1) {
126 6         20 return (($x-3*$y)/2, # rotate +60
127             ($x+$y)/2);
128             } else {
129 8         25 return (($x+3*$y)/-2, # rotate +120
130             ($x-$y)/2);
131             }
132             }
133              
134             sub xy_to_n {
135 19     19 1 1128 my ($self, $x, $y) = @_;
136              
137 19         45 $x = round_nearest ($x);
138 19         38 $y = round_nearest ($y);
139             ### HexArms xy_to_n: "x=$x, y=$y"
140 19 50       44 if (($x ^ $y) & 1) {
141 0         0 return undef; # nothing on odd points
142             }
143 19 100 100     47 if ($x == 0 && $y == 0) {
144 1         3 return 1;
145             }
146              
147 18         22 my $rot = 0;
148             # eg. y=2 have (0<=>$y)-$y == -1-2 == -3
149 18 100       37 if ($x < (0 <=> $y) - $y) {
150             ### left diagonal half ...
151 9         12 $rot = 3;
152 9         12 $x = -$x; # rotate 180
153 9         15 $y = -$y;
154             }
155 18 100       49 if ($x < $y) {
    100          
156             ### upper mid sixth, rot 2 ...
157 6         12 $rot += 2;
158 6         15 ($x,$y) = ((3*$y-$x)/2, # rotate -120
159             ($x+$y)/-2);
160             } elsif ($y > 0) {
161             ### first sixth, rot 1 ...
162 6         8 $rot++;
163 6         17 ($x,$y) = (($x+3*$y)/2, # rotate -60
164             ($y-$x)/2);
165             } else {
166             ### last sixth, rot 0 ...
167             }
168             ### assert: ($x+$y) % 2 == 0
169              
170             # diagonal down from N=2
171             # d=0 n=2
172             # d=6 n=128
173             # d=12 n=470
174             # N = (3 d^2 + 3 d + 2)
175             # = ((3*$d + 3)*$d + 2)
176             # xoffset = 3*($x+$y-2)
177             # N + xoffset = ((3*$d + 3)*$d + 2) + 3*($x+$y-2)
178             # = (3*$d + 3)*$d + 2 + 3*($x+$y) - 6
179             # = (3*$d + 3)*$d + 3*($x+$y) - 4
180             #
181 18         33 my $d = ($x-$y-2)/2;
182             ### xy: "$x,$y"
183             ### $rot
184             ### x offset: $x+$y-2
185             ### x offset sixes: 3*($x+$y-2)
186             ### quadratic: "d=$d q=".((3*$d + 3)*$d + 2)
187             ### d mod: $d % 6
188             ### rot d mod: (($rot-$d) % 6)
189 18         51 return ((3*$d + 3)*$d) + 3*($x+$y) - 4 + (($rot-$d) % 6);
190             }
191              
192             # not exact
193             sub rect_to_n_range {
194 24     24 1 2579 my ($self, $x1,$y1, $x2,$y2) = @_;
195              
196             # d = [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
197             # Nmax = [ 7, 19, 37, 61, 91, 127, 169, 217, 271 ]
198             # being the N=7 arm one spot before the corner of each run
199             # N = (3 d^2 + 3 d + 1)
200             # = ((3*$d + 3)*$d + 1)
201             #
202 24         46 my $d = _rect_to_hex_radius ($x1,$y1, $x2,$y2);
203 24         58 return (1,
204             ((3*$d + 3)*$d + 1));
205             }
206              
207             # hexagonal distance
208             sub _rect_to_hex_radius {
209 24     24   43 my ($x1,$y1, $x2,$y2) = @_;
210              
211 24         55 $x1 = abs (round_nearest ($x1));
212 24         44 $y1 = abs (round_nearest ($y1));
213 24         45 $x2 = abs (round_nearest ($x2));
214 24         44 $y2 = abs (round_nearest ($y2));
215              
216             # radial symmetric in +/-y
217 24         60 my $y = max (abs($y1), abs($y2));
218              
219             # radial symmetric in +/-x
220 24         52 my $x = max (abs($x1), abs($x2));
221              
222 24 100       62 return ($y >= $x
223             ? $y # middle
224             : int(($x + $y + 1)/2)); # end, round up
225             }
226              
227             1;
228             __END__