line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2010, 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
|
|
|
|
|
|
|
package Math::PlanePath::HexSpiralSkewed; |
20
|
2
|
|
|
2
|
|
1306
|
use 5.004; |
|
2
|
|
|
|
|
7
|
|
21
|
2
|
|
|
2
|
|
8
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
63
|
|
22
|
|
|
|
|
|
|
#use List::Util 'max'; |
23
|
|
|
|
|
|
|
*max = \&Math::PlanePath::_max; |
24
|
|
|
|
|
|
|
|
25
|
2
|
|
|
2
|
|
7
|
use vars '$VERSION', '@ISA'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
124
|
|
26
|
|
|
|
|
|
|
$VERSION = 127; |
27
|
2
|
|
|
2
|
|
561
|
use Math::PlanePath; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
73
|
|
28
|
|
|
|
|
|
|
*_sqrtint = \&Math::PlanePath::_sqrtint; |
29
|
|
|
|
|
|
|
@ISA = ('Math::PlanePath'); |
30
|
|
|
|
|
|
|
|
31
|
2
|
|
|
2
|
|
393
|
use Math::PlanePath::HexSpiral; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
51
|
|
32
|
|
|
|
|
|
|
use Math::PlanePath::Base::Generic |
33
|
2
|
|
|
2
|
|
11
|
'round_nearest'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
68
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
36
|
|
|
|
|
|
|
#use Devel::Comments; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
2
|
|
|
2
|
|
10
|
use Math::PlanePath::SquareSpiral; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
84
|
|
40
|
|
|
|
|
|
|
*parameter_info_array = \&Math::PlanePath::SquareSpiral::parameter_info_array; |
41
|
2
|
|
|
2
|
|
10
|
use constant xy_is_visited => 1; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
96
|
|
42
|
|
|
|
|
|
|
|
43
|
2
|
|
|
2
|
|
10
|
use constant dx_minimum => -1; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
68
|
|
44
|
2
|
|
|
2
|
|
9
|
use constant dx_maximum => 1; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
72
|
|
45
|
2
|
|
|
2
|
|
9
|
use constant dy_minimum => -1; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
75
|
|
46
|
2
|
|
|
2
|
|
9
|
use constant dy_maximum => 1; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
103
|
|
47
|
|
|
|
|
|
|
|
48
|
2
|
|
|
|
|
157
|
use constant _UNDOCUMENTED__dxdy_list => (1,0, # E four plus |
49
|
|
|
|
|
|
|
0,1, # N NW and SE |
50
|
|
|
|
|
|
|
-1,1, # NW |
51
|
|
|
|
|
|
|
-1,0, # W |
52
|
|
|
|
|
|
|
0,-1, # S |
53
|
|
|
|
|
|
|
1,-1, # SE |
54
|
2
|
|
|
2
|
|
10
|
); |
|
2
|
|
|
|
|
2
|
|
55
|
|
|
|
|
|
|
*x_negative_at_n = \&Math::PlanePath::HexSpiral::x_negative_at_n; |
56
|
|
|
|
|
|
|
*y_negative_at_n |
57
|
|
|
|
|
|
|
= \&Math::PlanePath::HexSpiral::y_negative_at_n; |
58
|
|
|
|
|
|
|
*_UNDOCUMENTED__dxdy_list_at_n |
59
|
|
|
|
|
|
|
= \&Math::PlanePath::HexSpiral::_UNDOCUMENTED__dxdy_list_at_n; |
60
|
|
|
|
|
|
|
|
61
|
2
|
|
|
2
|
|
18
|
use constant dsumxy_minimum => -1; # W,S straight |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
94
|
|
62
|
2
|
|
|
2
|
|
11
|
use constant dsumxy_maximum => 1; # N,E straight |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
112
|
|
63
|
2
|
|
|
2
|
|
11
|
use constant ddiffxy_minimum => -2; # NW diagonal |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
76
|
|
64
|
2
|
|
|
2
|
|
10
|
use constant ddiffxy_maximum => 2; # SE diagonal |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
79
|
|
65
|
2
|
|
|
2
|
|
10
|
use constant dir_maximum_dxdy => (1,-1); # South-East |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
79
|
|
66
|
|
|
|
|
|
|
|
67
|
2
|
|
|
2
|
|
10
|
use constant turn_any_right => 0; # only left or straight |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
1296
|
|
68
|
|
|
|
|
|
|
sub _UNDOCUMENTED__turn_any_left_at_n { |
69
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
70
|
0
|
|
|
|
|
0
|
return $self->n_start + $self->{'wider'} + 1; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub new { |
77
|
5
|
|
|
5
|
1
|
539
|
my $self = shift->SUPER::new (@_); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# parameters |
80
|
5
|
|
50
|
|
|
29
|
$self->{'wider'} ||= 0; # default |
81
|
5
|
100
|
|
|
|
11
|
if (! defined $self->{'n_start'}) { |
82
|
3
|
|
|
|
|
16
|
$self->{'n_start'} = $self->default_n_start; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
5
|
|
|
|
|
11
|
return $self; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Same as HexSpiral, but diagonal down and to the left is the downwards |
89
|
|
|
|
|
|
|
# vertical at x=-$w_left. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub n_to_xy { |
92
|
46
|
|
|
46
|
1
|
398
|
my ($self, $n) = @_; |
93
|
|
|
|
|
|
|
### HexSpiralSkewed n_to_xy(): $n |
94
|
|
|
|
|
|
|
|
95
|
46
|
|
|
|
|
62
|
$n = $n - $self->{'n_start'}; # N=0 basis |
96
|
46
|
50
|
|
|
|
74
|
if ($n < 0) { return; } |
|
0
|
|
|
|
|
0
|
|
97
|
|
|
|
|
|
|
|
98
|
46
|
|
|
|
|
60
|
my $w = $self->{'wider'}; |
99
|
46
|
|
|
|
|
63
|
my $w_right = int($w/2); |
100
|
46
|
|
|
|
|
55
|
my $w_left = $w - $w_right; |
101
|
|
|
|
|
|
|
#### $w |
102
|
|
|
|
|
|
|
#### $w_left |
103
|
|
|
|
|
|
|
#### $w_right |
104
|
|
|
|
|
|
|
|
105
|
46
|
|
|
|
|
97
|
my $d = int((_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3); |
106
|
|
|
|
|
|
|
#### d frac: (_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3 |
107
|
|
|
|
|
|
|
#### $d |
108
|
46
|
|
|
|
|
73
|
$n -= (3*$d + 2 + 2*$w)*$d + 1; |
109
|
|
|
|
|
|
|
#### remainder: $n |
110
|
|
|
|
|
|
|
|
111
|
46
|
|
|
|
|
53
|
$n += 1; # N=1 basis |
112
|
|
|
|
|
|
|
|
113
|
46
|
100
|
|
|
|
76
|
if ($n <= $d+1+$w) { |
114
|
|
|
|
|
|
|
#### bottom horizontal |
115
|
22
|
|
|
|
|
47
|
return ($n - $w_left, |
116
|
|
|
|
|
|
|
-$d); |
117
|
|
|
|
|
|
|
} |
118
|
24
|
|
|
|
|
31
|
$n -= $d+1+$w; |
119
|
24
|
100
|
|
|
|
37
|
if ($n <= $d) { |
120
|
|
|
|
|
|
|
#### right lower vertical, being 1 shorter: $n |
121
|
4
|
|
|
|
|
10
|
return ($d + 1 + $w_right, |
122
|
|
|
|
|
|
|
$n - $d); |
123
|
|
|
|
|
|
|
} |
124
|
20
|
|
|
|
|
25
|
$n -= $d; |
125
|
20
|
100
|
|
|
|
41
|
if ($n <= $d+1) { |
126
|
|
|
|
|
|
|
#### right upper diagonal: $n |
127
|
6
|
|
|
|
|
15
|
return (-$n + $d + 1 + $w_right, |
128
|
|
|
|
|
|
|
$n); |
129
|
|
|
|
|
|
|
} |
130
|
14
|
|
|
|
|
16
|
$d = $d + 1; # no warnings if $d==infinity |
131
|
14
|
|
|
|
|
14
|
$n -= $d; |
132
|
14
|
100
|
|
|
|
19
|
if ($n <= $d+$w) { |
133
|
|
|
|
|
|
|
#### top horizontal |
134
|
6
|
|
|
|
|
11
|
return (-$n + $w_right, |
135
|
|
|
|
|
|
|
$d); |
136
|
|
|
|
|
|
|
} |
137
|
8
|
|
|
|
|
11
|
$n -= $d+$w; |
138
|
8
|
100
|
|
|
|
17
|
if ($n <= $d) { |
139
|
|
|
|
|
|
|
#### left upper vertical |
140
|
6
|
|
|
|
|
13
|
return (-$d - $w_left, |
141
|
|
|
|
|
|
|
-$n + $d); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
#### left lower diagonal |
144
|
2
|
|
|
|
|
3
|
$n -= $d; |
145
|
2
|
|
|
|
|
5
|
return ($n - $d - $w_left, |
146
|
|
|
|
|
|
|
-$n); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub xy_to_n { |
150
|
4
|
|
|
4
|
1
|
241
|
my ($self, $x, $y) = @_; |
151
|
|
|
|
|
|
|
### xy_to_n(): "$x, $y" |
152
|
|
|
|
|
|
|
|
153
|
4
|
|
|
|
|
9
|
$x = round_nearest ($x); |
154
|
4
|
|
|
|
|
10
|
$y = round_nearest ($y); |
155
|
|
|
|
|
|
|
|
156
|
4
|
|
|
|
|
6
|
my $w = $self->{'wider'}; |
157
|
4
|
|
|
|
|
8
|
my $w_right = int($w/2); |
158
|
4
|
|
|
|
|
6
|
my $w_left = $w - $w_right; |
159
|
|
|
|
|
|
|
|
160
|
4
|
50
|
|
|
|
8
|
if ($y > 0) { |
161
|
0
|
|
|
|
|
0
|
$x -= $w_right; |
162
|
0
|
0
|
|
|
|
0
|
if ($x < -$y-$w) { |
163
|
|
|
|
|
|
|
### left upper vertical |
164
|
0
|
|
|
|
|
0
|
my $d = -$x - $w; |
165
|
|
|
|
|
|
|
### $d |
166
|
|
|
|
|
|
|
### base: (3*$d + 1 + 2*$w)*$d |
167
|
|
|
|
|
|
|
return ((3*$d + 1 + 2*$w)*$d |
168
|
|
|
|
|
|
|
- $y |
169
|
0
|
|
|
|
|
0
|
+ $self->{'n_start'}); |
170
|
|
|
|
|
|
|
} else { |
171
|
0
|
|
|
|
|
0
|
my $d = $y + max($x,0); |
172
|
|
|
|
|
|
|
### right upper diagonal and top horizontal |
173
|
|
|
|
|
|
|
### $d |
174
|
|
|
|
|
|
|
### base: (3*$d - 1 + 2*$w)*$d - $w |
175
|
|
|
|
|
|
|
return ((3*$d - 1 + 2*$w)*$d - $w |
176
|
|
|
|
|
|
|
- $x |
177
|
0
|
|
|
|
|
0
|
+ $self->{'n_start'}); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
} else { |
181
|
|
|
|
|
|
|
# $y < 0 |
182
|
4
|
|
|
|
|
5
|
$x += $w_left; |
183
|
4
|
100
|
|
|
|
7
|
if ($x-$w <= -$y) { |
184
|
2
|
|
|
|
|
6
|
my $d = -$y + max(-$x,0); |
185
|
|
|
|
|
|
|
### left lower diagonal and bottom horizontal |
186
|
|
|
|
|
|
|
### $d |
187
|
|
|
|
|
|
|
### base: (3*$d + 2 + 2*$w)*$d + 1 |
188
|
|
|
|
|
|
|
return ((3*$d + 2 + 2*$w)*$d |
189
|
|
|
|
|
|
|
+ $x |
190
|
2
|
|
|
|
|
7
|
+ $self->{'n_start'}); |
191
|
|
|
|
|
|
|
} else { |
192
|
|
|
|
|
|
|
### right lower vertical |
193
|
2
|
|
|
|
|
3
|
my $d = $x - $w; |
194
|
|
|
|
|
|
|
### $d |
195
|
|
|
|
|
|
|
### base: (3*$d - 2 + 2*$w)*$d + 1 - $w |
196
|
|
|
|
|
|
|
return ((3*$d - 2 + 2*$w)*$d - $w |
197
|
|
|
|
|
|
|
+ $y |
198
|
2
|
|
|
|
|
5
|
+ $self->{'n_start'}); |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# not exact |
204
|
|
|
|
|
|
|
sub rect_to_n_range { |
205
|
0
|
|
|
0
|
1
|
|
my ($self, $x1,$y1, $x2,$y2) = @_; |
206
|
|
|
|
|
|
|
### HexSpiralSkewed rect_to_n_range(): $x1,$y1, $x2,$y2 |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
$x1 = round_nearest ($x1); |
209
|
0
|
|
|
|
|
|
$y1 = round_nearest ($y1); |
210
|
0
|
|
|
|
|
|
$x2 = round_nearest ($x2); |
211
|
0
|
|
|
|
|
|
$y2 = round_nearest ($y2); |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
my $w = $self->{'wider'}; |
214
|
0
|
|
|
|
|
|
my $w_right = int($w/2); |
215
|
0
|
|
|
|
|
|
my $w_left = $w - $w_right; |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
my $d = 0; |
218
|
0
|
|
|
|
|
|
foreach my $x ($x1, $x2) { |
219
|
0
|
|
|
|
|
|
$x += $w_left; |
220
|
0
|
0
|
|
|
|
|
if ($x >= $w) { |
221
|
0
|
|
|
|
|
|
$x -= $w; |
222
|
|
|
|
|
|
|
} |
223
|
0
|
|
|
|
|
|
foreach my $y ($y1, $y2) { |
224
|
0
|
0
|
|
|
|
|
$d = max ($d, |
225
|
|
|
|
|
|
|
(($y > 0) == ($x > 0) |
226
|
|
|
|
|
|
|
? abs($x) + abs($y) # top right or bottom left diagonals |
227
|
|
|
|
|
|
|
: max(abs($x),abs($y)))); # top left or bottom right squares |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
0
|
|
|
|
|
|
$d += 1; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# diagonal downwards bottom right being the end of a revolution |
233
|
|
|
|
|
|
|
# s=0 |
234
|
|
|
|
|
|
|
# s=1 n=7 |
235
|
|
|
|
|
|
|
# s=2 n=19 |
236
|
|
|
|
|
|
|
# s=3 n=37 |
237
|
|
|
|
|
|
|
# s=4 n=61 |
238
|
|
|
|
|
|
|
# n = 3*$d*$d + 3*$d + 1 |
239
|
|
|
|
|
|
|
# |
240
|
|
|
|
|
|
|
### gives: "sum $d is " . (3*$d*$d + 3*$d + 1) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# ENHANCE-ME: find actual minimum if rect doesn't cover 0,0 |
243
|
|
|
|
|
|
|
return ($self->{'n_start'}, |
244
|
0
|
|
|
|
|
|
(3*$d + 3 + 2*$self->{'wider'})*$d + $self->{'n_start'}); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
1; |
248
|
|
|
|
|
|
|
__END__ |