line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 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
|
|
|
|
|
|
|
# ENHANCE-ME: Explanation for this bit ... |
20
|
|
|
|
|
|
|
# 'arms=4' => |
21
|
|
|
|
|
|
|
# { dSum => 'A020985', # GRS |
22
|
|
|
|
|
|
|
# # OEIS-Other: A020985 planepath=AlternatePaper,arms=4 delta_type=dSum |
23
|
|
|
|
|
|
|
# }, |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
package Math::PlanePath::AlternatePaper; |
27
|
2
|
|
|
2
|
|
10044
|
use 5.004; |
|
2
|
|
|
|
|
8
|
|
28
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
77
|
|
29
|
2
|
|
|
2
|
|
14
|
use List::Util 'min'; # 'max' |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
226
|
|
30
|
|
|
|
|
|
|
*max = \&Math::PlanePath::_max; |
31
|
|
|
|
|
|
|
|
32
|
2
|
|
|
2
|
|
13
|
use vars '$VERSION', '@ISA'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
168
|
|
33
|
|
|
|
|
|
|
$VERSION = 129; |
34
|
2
|
|
|
2
|
|
770
|
use Math::PlanePath; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
50
|
|
35
|
2
|
|
|
2
|
|
437
|
use Math::PlanePath::Base::NSEW; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
81
|
|
36
|
|
|
|
|
|
|
@ISA = ('Math::PlanePath::Base::NSEW', |
37
|
|
|
|
|
|
|
'Math::PlanePath'); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
use Math::PlanePath::Base::Generic |
40
|
2
|
|
|
|
|
108
|
'is_infinite', |
41
|
2
|
|
|
2
|
|
14
|
'round_nearest'; |
|
2
|
|
|
|
|
2
|
|
42
|
|
|
|
|
|
|
use Math::PlanePath::Base::Digits |
43
|
2
|
|
|
|
|
233
|
'round_down_pow', |
44
|
|
|
|
|
|
|
'digit_split_lowtohigh', |
45
|
|
|
|
|
|
|
'digit_join_lowtohigh', |
46
|
2
|
|
|
2
|
|
505
|
'bit_split_lowtohigh'; |
|
2
|
|
|
|
|
4
|
|
47
|
|
|
|
|
|
|
*_divrem = \&Math::PlanePath::_divrem; |
48
|
|
|
|
|
|
|
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
51
|
|
|
|
|
|
|
# use Smart::Comments; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
2
|
|
|
|
|
124
|
use constant parameter_info_array => [ { name => 'arms', |
55
|
|
|
|
|
|
|
share_key => 'arms_8', |
56
|
|
|
|
|
|
|
display => 'Arms', |
57
|
|
|
|
|
|
|
type => 'integer', |
58
|
|
|
|
|
|
|
minimum => 1, |
59
|
|
|
|
|
|
|
maximum => 8, |
60
|
|
|
|
|
|
|
default => 1, |
61
|
|
|
|
|
|
|
width => 1, |
62
|
|
|
|
|
|
|
description => 'Arms', |
63
|
2
|
|
|
2
|
|
15
|
} ]; |
|
2
|
|
|
|
|
4
|
|
64
|
|
|
|
|
|
|
|
65
|
2
|
|
|
2
|
|
12
|
use constant n_start => 0; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
558
|
|
66
|
|
|
|
|
|
|
sub x_negative { |
67
|
6
|
|
|
6
|
1
|
107
|
my ($self) = @_; |
68
|
6
|
|
|
|
|
17
|
return ($self->{'arms'} >= 3); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
sub y_negative { |
71
|
6
|
|
|
6
|
1
|
364
|
my ($self) = @_; |
72
|
6
|
|
|
|
|
20
|
return ($self->{'arms'} >= 5); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
|
my @x_negative_at_n = (undef, |
76
|
|
|
|
|
|
|
undef,undef,8,7, |
77
|
|
|
|
|
|
|
4,4,4,4); |
78
|
|
|
|
|
|
|
sub x_negative_at_n { |
79
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
80
|
0
|
|
|
|
|
0
|
return $x_negative_at_n[$self->{'arms'}]; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
{ |
84
|
|
|
|
|
|
|
my @y_negative_at_n = (undef, |
85
|
|
|
|
|
|
|
undef,undef,undef,undef, |
86
|
|
|
|
|
|
|
44,23,13,14); |
87
|
|
|
|
|
|
|
sub y_negative_at_n { |
88
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
89
|
0
|
|
|
|
|
0
|
return $y_negative_at_n[$self->{'arms'}]; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub sumxy_minimum { |
94
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
95
|
0
|
0
|
|
|
|
0
|
return ($self->arms_count <= 3 |
96
|
|
|
|
|
|
|
? 0 # 1,2,3 arms above X=-Y diagonal |
97
|
|
|
|
|
|
|
: undef); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
sub diffxy_minimum { |
100
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
101
|
0
|
0
|
|
|
|
0
|
return ($self->arms_count == 1 |
102
|
|
|
|
|
|
|
? 0 # 1 arms right of X=Y diagonal |
103
|
|
|
|
|
|
|
: undef); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
2
|
|
|
2
|
|
15
|
use constant turn_any_straight => 0; # never straight |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
3517
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub new { |
112
|
37
|
|
|
37
|
1
|
6402
|
my $self = shift->SUPER::new(@_); |
113
|
37
|
|
100
|
|
|
335
|
$self->{'arms'} = max(1, min(8, $self->{'arms'} || 1)); |
114
|
37
|
|
|
|
|
93
|
return $self; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
{ |
118
|
|
|
|
|
|
|
# <------ |
119
|
|
|
|
|
|
|
# state=0 /| +----+----+ |
120
|
|
|
|
|
|
|
# (dir=0) / | |\ 1||<--/ |
121
|
|
|
|
|
|
|
# /2 | |^\ || 0/ |
122
|
|
|
|
|
|
|
# /-->| || \v| / |
123
|
|
|
|
|
|
|
# +----+ ||3 \|/ |
124
|
|
|
|
|
|
|
# /|\ 3|| +----+ |
125
|
|
|
|
|
|
|
# / |^\ || |<--/ state=4 |
126
|
|
|
|
|
|
|
# / 0|| \v| | 2/ (dir=2) |
127
|
|
|
|
|
|
|
# /-->||1 \| | / |
128
|
|
|
|
|
|
|
# +----+----+ |/ |
129
|
|
|
|
|
|
|
# --------> |
130
|
|
|
|
|
|
|
# |
131
|
|
|
|
|
|
|
# |\ state=8 +----+----+ state=12 |
132
|
|
|
|
|
|
|
# ^ |^\ (dir=1) \ 1||<--/| | (dir=3) |
133
|
|
|
|
|
|
|
# | || \ \ || 0/ | | |
134
|
|
|
|
|
|
|
# | ||3 \ \v| /2 | | |
135
|
|
|
|
|
|
|
# | +----+ \|/-->| | |
136
|
|
|
|
|
|
|
# | |<--/|\ +----+ | |
137
|
|
|
|
|
|
|
# | | 2/ |^\ \ 3|| | |
138
|
|
|
|
|
|
|
# | | /0 || \ \ || | |
139
|
|
|
|
|
|
|
# | |/-->||1 \ \v| v |
140
|
|
|
|
|
|
|
# +----+----+ \| |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my @next_state = (0, 8, 0, 12, # forward |
143
|
|
|
|
|
|
|
4, 12, 4, 8, # forward NW |
144
|
|
|
|
|
|
|
0, 8, 4, 8, # reverse |
145
|
|
|
|
|
|
|
4, 12, 0, 12, # reverse NE |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
my @digit_to_x = (0,1,1,1, |
148
|
|
|
|
|
|
|
1,0,0,0, |
149
|
|
|
|
|
|
|
0,1,0,0, |
150
|
|
|
|
|
|
|
1,0,1,1, |
151
|
|
|
|
|
|
|
); |
152
|
|
|
|
|
|
|
my @digit_to_y = (0,0,1,0, |
153
|
|
|
|
|
|
|
1,1,0,1, |
154
|
|
|
|
|
|
|
0,0,0,1, |
155
|
|
|
|
|
|
|
1,1,1,0, |
156
|
|
|
|
|
|
|
); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# state_to_dx[S] == state_to_x[S+3] - state_to_x[S+0] |
159
|
|
|
|
|
|
|
my @state_to_dx = (1, -1, 0, 0); |
160
|
|
|
|
|
|
|
my @state_to_dy = (0, 0, 1, -1); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub n_to_xy { |
163
|
7847
|
|
|
7847
|
1
|
252779
|
my ($self, $n) = @_; |
164
|
|
|
|
|
|
|
### AlternatePaper n_to_xy(): $n |
165
|
|
|
|
|
|
|
|
166
|
7847
|
50
|
|
|
|
15428
|
if ($n < 0) { return; } |
|
0
|
|
|
|
|
0
|
|
167
|
7847
|
50
|
|
|
|
15546
|
if (is_infinite($n)) { return ($n, $n); } |
|
0
|
|
|
|
|
0
|
|
168
|
|
|
|
|
|
|
|
169
|
7847
|
|
|
|
|
14588
|
my $int = int($n); # integer part |
170
|
7847
|
|
|
|
|
11811
|
$n -= $int; # fraction part |
171
|
|
|
|
|
|
|
### $int |
172
|
|
|
|
|
|
|
### $n |
173
|
|
|
|
|
|
|
|
174
|
7847
|
|
|
|
|
11019
|
my $zero = ($int * 0); # inherit bignum 0 |
175
|
7847
|
|
|
|
|
19281
|
my $arm = _divrem_mutate ($int, $self->{'arms'}); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
### $arm |
178
|
|
|
|
|
|
|
### $int |
179
|
|
|
|
|
|
|
|
180
|
7847
|
|
|
|
|
16584
|
my @digits = digit_split_lowtohigh($int,4); |
181
|
7847
|
|
|
|
|
11173
|
my $state = 0; |
182
|
7847
|
|
|
|
|
11090
|
my (@xbits,@ybits); # bits low to high (like @digits) |
183
|
|
|
|
|
|
|
|
184
|
7847
|
|
|
|
|
14671
|
foreach my $i (reverse 0 .. $#digits) { # high to low |
185
|
19082
|
|
|
|
|
26605
|
$state += $digits[$i]; |
186
|
19082
|
|
|
|
|
27147
|
$xbits[$i] = $digit_to_x[$state]; |
187
|
19082
|
|
|
|
|
26613
|
$ybits[$i] = $digit_to_y[$state]; |
188
|
19082
|
|
|
|
|
28304
|
$state = $next_state[$state]; |
189
|
|
|
|
|
|
|
} |
190
|
7847
|
|
|
|
|
17873
|
my $x = digit_join_lowtohigh(\@xbits,2,$zero); |
191
|
7847
|
|
|
|
|
15480
|
my $y = digit_join_lowtohigh(\@ybits,2,$zero); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# X+1,Y+1 for final state=4 or state=12 |
194
|
7847
|
|
|
|
|
11947
|
$x += $digit_to_x[$state]; |
195
|
7847
|
|
|
|
|
11011
|
$y += $digit_to_y[$state]; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
### final: "xy=$x,$y state=$state" |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# apply possible fraction part of $n in direction of $state |
200
|
7847
|
|
|
|
|
12474
|
$x = $n * $state_to_dx[$state >>= 2] + $x; |
201
|
7847
|
|
|
|
|
10868
|
$y = $n * $state_to_dy[$state] + $y; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# rotate,transpose for arm number |
204
|
7847
|
100
|
|
|
|
14890
|
if ($arm & 1) { |
205
|
3366
|
|
|
|
|
5982
|
($x,$y) = ($y,$x); # transpose |
206
|
|
|
|
|
|
|
} |
207
|
7847
|
100
|
|
|
|
13562
|
if ($arm & 2) { |
208
|
2886
|
|
|
|
|
5076
|
($x,$y) = (-$y,$x+1); # rotate +90 and shift origin to X=0,Y=1 |
209
|
|
|
|
|
|
|
} |
210
|
7847
|
100
|
|
|
|
13544
|
if ($arm & 4) { |
211
|
2023
|
|
|
|
|
2734
|
$x = -1 - $x; # rotate +180 and shift origin to X=-1,Y=1 |
212
|
2023
|
|
|
|
|
2636
|
$y = 1 - $y; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
### rotated return: "$x,$y" |
216
|
7847
|
|
|
|
|
19134
|
return ($x,$y); |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# 8 |
221
|
|
|
|
|
|
|
# |
222
|
|
|
|
|
|
|
# 42 43 7 |
223
|
|
|
|
|
|
|
# |
224
|
|
|
|
|
|
|
# 40 41/45 44 6 |
225
|
|
|
|
|
|
|
# |
226
|
|
|
|
|
|
|
# 34 35/39 38/46 47 5 |
227
|
|
|
|
|
|
|
# |
228
|
|
|
|
|
|
|
# 32-33/53-36/52-37/49---48 4 |
229
|
|
|
|
|
|
|
# | \ |
230
|
|
|
|
|
|
|
# 10 11/31 30/54 51/55 50/58 59 3 |
231
|
|
|
|
|
|
|
# | \ |
232
|
|
|
|
|
|
|
# 8 9/13 12/28 25/29 24/56 57/61 60 2 |
233
|
|
|
|
|
|
|
# | \ |
234
|
|
|
|
|
|
|
# 2 3/7 6/14 15/27 18/26 19/23 22/62 63 1 |
235
|
|
|
|
|
|
|
# | \ |
236
|
|
|
|
|
|
|
# 0 1 4 5 16 17 20 21 ==64 0 |
237
|
|
|
|
|
|
|
# |
238
|
|
|
|
|
|
|
# 0 1 2 3 4 5 6 7 8 |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub xy_to_n { |
241
|
121
|
|
|
121
|
1
|
8387
|
return scalar((shift->xy_to_n_list(@_))[0]); |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
sub xy_to_n_list { |
244
|
159
|
|
|
159
|
1
|
5252
|
my ($self, $x, $y) = @_; |
245
|
|
|
|
|
|
|
### AlternatePaper xy_to_n(): "$x, $y" |
246
|
|
|
|
|
|
|
|
247
|
159
|
|
|
|
|
400
|
$x = round_nearest($x); |
248
|
159
|
|
|
|
|
317
|
$y = round_nearest($y); |
249
|
159
|
50
|
|
|
|
329
|
if (is_infinite($x)) { return $x; } |
|
0
|
|
|
|
|
0
|
|
250
|
159
|
50
|
|
|
|
340
|
if (is_infinite($y)) { return $y; } |
|
0
|
|
|
|
|
0
|
|
251
|
|
|
|
|
|
|
|
252
|
159
|
|
|
|
|
331
|
my $arms = $self->{'arms'}; |
253
|
159
|
|
|
|
|
234
|
my $arm = 0; |
254
|
159
|
|
|
|
|
216
|
my @ret; |
255
|
159
|
|
|
|
|
320
|
foreach (1 .. 4) { |
256
|
231
|
|
|
|
|
441
|
push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y); |
|
181
|
|
|
|
|
400
|
|
257
|
231
|
100
|
|
|
|
506
|
last if ++$arm >= $arms; |
258
|
|
|
|
|
|
|
|
259
|
113
|
|
|
|
|
226
|
($x,$y) = ($y,$x); # transpose |
260
|
113
|
|
|
|
|
213
|
push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y); |
|
41
|
|
|
|
|
87
|
|
261
|
113
|
100
|
|
|
|
247
|
last if ++$arm >= $arms; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# X,Y -> Y,X |
264
|
|
|
|
|
|
|
# -> Y,X-1 # Y-1 shift |
265
|
|
|
|
|
|
|
# -> X-1,-Y # rot -90 |
266
|
|
|
|
|
|
|
# ie. mirror across X axis and shift |
267
|
72
|
|
|
|
|
146
|
($x,$y) = ($x-1,-$y); |
268
|
|
|
|
|
|
|
} |
269
|
159
|
|
|
|
|
501
|
return sort {$a<=>$b} @ret; |
|
86
|
|
|
|
|
294
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub _xy_to_n_list__onearm { |
273
|
344
|
|
|
344
|
|
561
|
my ($self, $x, $y) = @_; |
274
|
|
|
|
|
|
|
### _xy_to_n_list__onearm(): "$x,$y" |
275
|
|
|
|
|
|
|
|
276
|
344
|
100
|
100
|
|
|
1117
|
if ($y < 0 || $y > $x || $x < 0) { |
|
|
|
66
|
|
|
|
|
277
|
|
|
|
|
|
|
### outside first octant ... |
278
|
182
|
|
|
|
|
296
|
return; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
162
|
|
|
|
|
389
|
my ($len,$level) = round_down_pow($x, 2); |
282
|
|
|
|
|
|
|
### $len |
283
|
|
|
|
|
|
|
### $level |
284
|
162
|
50
|
|
|
|
370
|
if (is_infinite($level)) { |
285
|
0
|
|
|
|
|
0
|
return; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
162
|
|
|
|
|
325
|
my $n = my $big_n = $x * 0 * $y; # inherit bignum 0 |
289
|
162
|
|
|
|
|
215
|
my $rev = 0; |
290
|
|
|
|
|
|
|
|
291
|
162
|
|
|
|
|
225
|
my $big_x = $x; |
292
|
162
|
|
|
|
|
226
|
my $big_y = $y; |
293
|
162
|
|
|
|
|
244
|
my $big_rev = 0; |
294
|
|
|
|
|
|
|
|
295
|
162
|
|
|
|
|
312
|
while ($level-- >= 0) { |
296
|
|
|
|
|
|
|
### at: "$x,$y len=$len n=$n" |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# the smaller N |
299
|
|
|
|
|
|
|
{ |
300
|
447
|
|
|
|
|
600
|
$n *= 4; |
301
|
447
|
100
|
|
|
|
691
|
if ($rev) { |
302
|
135
|
100
|
|
|
|
256
|
if ($x+$y < 2*$len) { |
303
|
|
|
|
|
|
|
### rev 0 or 1 ... |
304
|
51
|
100
|
|
|
|
83
|
if ($x < $len) { |
305
|
|
|
|
|
|
|
} else { |
306
|
|
|
|
|
|
|
### rev 1 ... |
307
|
24
|
|
|
|
|
42
|
$rev = 0; |
308
|
24
|
|
|
|
|
34
|
$n -= 2; |
309
|
24
|
|
|
|
|
43
|
($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90 |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
} else { |
313
|
|
|
|
|
|
|
### rev 2 or 3 ... |
314
|
84
|
100
|
66
|
|
|
268
|
if ($y > $len || ($x==$len && $y==$len)) { |
|
|
|
100
|
|
|
|
|
315
|
|
|
|
|
|
|
### rev 2 ... |
316
|
35
|
|
|
|
|
55
|
$n -= 2; |
317
|
35
|
|
|
|
|
46
|
$x -= $len; |
318
|
35
|
|
|
|
|
48
|
$y -= $len; |
319
|
|
|
|
|
|
|
} else { |
320
|
|
|
|
|
|
|
### rev 3 ... |
321
|
49
|
|
|
|
|
86
|
$n -= 4; |
322
|
49
|
|
|
|
|
67
|
$rev = 0; |
323
|
49
|
|
|
|
|
97
|
($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90 |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} else { |
327
|
312
|
100
|
100
|
|
|
1338
|
if ($x+$y <= 2*$len |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
328
|
|
|
|
|
|
|
&& !($x==$len && $y==$len) |
329
|
|
|
|
|
|
|
&& !($x==2*$len && $y==0)) { |
330
|
|
|
|
|
|
|
### 0 or 1 ... |
331
|
180
|
100
|
|
|
|
342
|
if ($x <= $len) { |
332
|
|
|
|
|
|
|
} else { |
333
|
|
|
|
|
|
|
### 1 ... |
334
|
57
|
|
|
|
|
90
|
$n += 2; |
335
|
57
|
|
|
|
|
83
|
$rev = 1; |
336
|
57
|
|
|
|
|
122
|
($x,$y) = ($len-$y, $x-$len); # x-len,y-len then rotate +90 |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
} else { |
340
|
|
|
|
|
|
|
### 2 or 3 ... |
341
|
132
|
100
|
100
|
|
|
447
|
if ($y >= $len && !($x==2*$len && $y==$len)) { |
|
|
|
100
|
|
|
|
|
342
|
75
|
|
|
|
|
109
|
$n += 2; |
343
|
75
|
|
|
|
|
111
|
$x -= $len; |
344
|
75
|
|
|
|
|
102
|
$y -= $len; |
345
|
|
|
|
|
|
|
} else { |
346
|
57
|
|
|
|
|
86
|
$n += 4; |
347
|
57
|
|
|
|
|
80
|
$rev = 1; |
348
|
57
|
|
|
|
|
105
|
($x,$y) = ($y, 2*$len-$x); # to origin then rotate -90 |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# the bigger N |
355
|
|
|
|
|
|
|
{ |
356
|
447
|
|
|
|
|
563
|
$big_n *= 4; |
|
447
|
|
|
|
|
533
|
|
|
447
|
|
|
|
|
595
|
|
357
|
447
|
100
|
|
|
|
694
|
if ($big_rev) { |
358
|
169
|
100
|
100
|
|
|
667
|
if ($big_x+$big_y <= 2*$len |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
359
|
|
|
|
|
|
|
&& !($big_x==$len && $big_y==$len) |
360
|
|
|
|
|
|
|
&& !($big_x==2*$len && $big_y==0)) { |
361
|
|
|
|
|
|
|
### rev 0 or 1 ... |
362
|
77
|
100
|
|
|
|
130
|
if ($big_x <= $len) { |
363
|
|
|
|
|
|
|
} else { |
364
|
|
|
|
|
|
|
### rev 1 ... |
365
|
30
|
|
|
|
|
53
|
$big_rev = 0; |
366
|
30
|
|
|
|
|
39
|
$big_n -= 2; |
367
|
30
|
|
|
|
|
57
|
($big_x,$big_y) = ($len-$big_y, $big_x-$len); # x-len,y-len then rotate +90 |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
} else { |
371
|
|
|
|
|
|
|
### rev 2 or 3 ... |
372
|
92
|
100
|
100
|
|
|
277
|
if ($big_y >= $len && !($big_x==2*$len && $big_y==$len)) { |
|
|
|
100
|
|
|
|
|
373
|
|
|
|
|
|
|
### rev 2 ... |
374
|
37
|
|
|
|
|
55
|
$big_n -= 2; |
375
|
37
|
|
|
|
|
52
|
$big_x -= $len; |
376
|
37
|
|
|
|
|
58
|
$big_y -= $len; |
377
|
|
|
|
|
|
|
} else { |
378
|
|
|
|
|
|
|
### rev 3 ... |
379
|
55
|
|
|
|
|
89
|
$big_n -= 4; |
380
|
55
|
|
|
|
|
69
|
$big_rev = 0; |
381
|
55
|
|
|
|
|
98
|
($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90 |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} else { |
385
|
278
|
100
|
|
|
|
485
|
if ($big_x+$big_y < 2*$len) { |
386
|
|
|
|
|
|
|
### 0 or 1 ... |
387
|
177
|
100
|
|
|
|
284
|
if ($big_x < $len) { |
388
|
|
|
|
|
|
|
} else { |
389
|
|
|
|
|
|
|
### 1 ... |
390
|
108
|
|
|
|
|
143
|
$big_n += 2; |
391
|
108
|
|
|
|
|
143
|
$big_rev = 1; |
392
|
108
|
|
|
|
|
205
|
($big_x,$big_y) = ($len-$big_y, $big_x-$len); # x-len,y-len then rotate +90 |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
} else { |
396
|
|
|
|
|
|
|
### 2 or 3 ... |
397
|
101
|
100
|
66
|
|
|
330
|
if ($big_y > $len || ($big_x==$len && $big_y==$len)) { |
|
|
|
100
|
|
|
|
|
398
|
60
|
|
|
|
|
85
|
$big_n += 2; |
399
|
60
|
|
|
|
|
76
|
$big_x -= $len; |
400
|
60
|
|
|
|
|
81
|
$big_y -= $len; |
401
|
|
|
|
|
|
|
} else { |
402
|
41
|
|
|
|
|
60
|
$big_n += 4; |
403
|
41
|
|
|
|
|
51
|
$big_rev = 1; |
404
|
41
|
|
|
|
|
77
|
($big_x,$big_y) = ($big_y, 2*$len-$big_x); # to origin then rotate -90 |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
} |
409
|
447
|
|
|
|
|
858
|
$len /= 2; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
162
|
100
|
|
|
|
282
|
if ($x) { |
413
|
66
|
100
|
|
|
|
122
|
$n += ($rev ? -1 : 1); |
414
|
|
|
|
|
|
|
} |
415
|
162
|
100
|
|
|
|
280
|
if ($big_x) { |
416
|
66
|
100
|
|
|
|
108
|
$big_n += ($big_rev ? -1 : 1); |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
### final: "$x,$y n=$n rev=$rev" |
420
|
|
|
|
|
|
|
### final: "$x,$y big_n=$n big_rev=$rev" |
421
|
|
|
|
|
|
|
|
422
|
162
|
100
|
|
|
|
411
|
return ($n, |
423
|
|
|
|
|
|
|
($n == $big_n ? () : ($big_n))); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# not exact |
428
|
|
|
|
|
|
|
sub rect_to_n_range { |
429
|
40
|
|
|
40
|
1
|
3466
|
my ($self, $x1,$y1, $x2,$y2) = @_; |
430
|
|
|
|
|
|
|
### AlternatePaper rect_to_n_range(): "$x1,$y1 $x2,$y2" |
431
|
|
|
|
|
|
|
|
432
|
40
|
|
|
|
|
105
|
$x1 = round_nearest($x1); |
433
|
40
|
|
|
|
|
82
|
$x2 = round_nearest($x2); |
434
|
40
|
|
|
|
|
78
|
$y1 = round_nearest($y1); |
435
|
40
|
|
|
|
|
74
|
$y2 = round_nearest($y2); |
436
|
|
|
|
|
|
|
|
437
|
40
|
50
|
|
|
|
83
|
($x1,$x2) = ($x2,$x1) if $x1 > $x2; |
438
|
40
|
50
|
|
|
|
83
|
($y1,$y2) = ($y2,$y1) if $y1 > $y2; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
### rounded: "$x1,$y1 $x2,$y2" |
441
|
|
|
|
|
|
|
|
442
|
40
|
|
|
|
|
82
|
my $arms = $self->{'arms'}; |
443
|
40
|
50
|
66
|
|
|
260
|
if (($arms == 1 && $y1 > $x2) # x2,y1 bottom right corner |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
444
|
|
|
|
|
|
|
|| ($arms <= 2 && $x2 < 0) |
445
|
|
|
|
|
|
|
|| ($arms <= 4 && $y2 < 0)) { |
446
|
|
|
|
|
|
|
### outside ... |
447
|
0
|
|
|
|
|
0
|
return (1,0); |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# arm start 0,1 at X=0,Y=0 |
451
|
|
|
|
|
|
|
# 2,3 at X=0,Y=1 |
452
|
|
|
|
|
|
|
# 4,5 at X=-1,Y=1 |
453
|
|
|
|
|
|
|
# 6,7 at X=-1,Y=1 |
454
|
|
|
|
|
|
|
# arms>=6 is arm=5 starting at Y=+1, so 1-$y1 |
455
|
|
|
|
|
|
|
# arms>=8 starts at X=-1 so extra +1 for x2 to the right in that case |
456
|
40
|
100
|
|
|
|
174
|
my ($len, $level) =round_down_pow (max ($x2+($arms>=8), |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
457
|
|
|
|
|
|
|
($arms >= 2 ? $y2 : ()), |
458
|
|
|
|
|
|
|
($arms >= 4 ? -$x1 : ()), |
459
|
|
|
|
|
|
|
($arms >= 6 ? 1-$y1 : ())), |
460
|
|
|
|
|
|
|
2); |
461
|
40
|
|
|
|
|
123
|
return (0, 4*$arms*$len*$len-1); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
my @dir4_to_dx = (1,0,-1,0); |
466
|
|
|
|
|
|
|
my @dir4_to_dy = (0,1,0,-1); |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub n_to_dxdy { |
469
|
2000
|
|
|
2000
|
1
|
37422
|
my ($self, $n) = @_; |
470
|
|
|
|
|
|
|
### n_to_dxdy(): $n |
471
|
|
|
|
|
|
|
|
472
|
2000
|
50
|
|
|
|
3579
|
if ($n < 0) { return; } |
|
0
|
|
|
|
|
0
|
|
473
|
2000
|
50
|
|
|
|
3557
|
if (is_infinite($n)) { return ($n,$n); } |
|
0
|
|
|
|
|
0
|
|
474
|
2000
|
|
|
|
|
3445
|
my $int = int($n); |
475
|
2000
|
|
|
|
|
2642
|
$n -= $int; # $n fraction part |
476
|
|
|
|
|
|
|
### $int |
477
|
|
|
|
|
|
|
### $n |
478
|
|
|
|
|
|
|
|
479
|
2000
|
|
|
|
|
3928
|
my $arm = _divrem_mutate ($int, $self->{'arms'}); |
480
|
|
|
|
|
|
|
### $arm |
481
|
|
|
|
|
|
|
### $int |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# $dir initial direction from the arm. |
484
|
|
|
|
|
|
|
# $inc +/-1 according to the bit position odd or even, but also odd |
485
|
|
|
|
|
|
|
# numbered arms are transposed so flip them. |
486
|
|
|
|
|
|
|
# |
487
|
2000
|
|
|
|
|
3796
|
my @bits = bit_split_lowtohigh($int); |
488
|
2000
|
|
|
|
|
3498
|
my $dir = ($arm+1) >> 1; |
489
|
2000
|
100
|
|
|
|
3885
|
my $inc = (($#bits ^ $arm) & 1 ? -1 : 1); |
490
|
2000
|
|
|
|
|
2875
|
my $prev = 0; |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
### @bits |
493
|
|
|
|
|
|
|
### initial dir: $dir |
494
|
|
|
|
|
|
|
### initial inc: $inc |
495
|
|
|
|
|
|
|
|
496
|
2000
|
|
|
|
|
3086
|
foreach my $bit (reverse @bits) { |
497
|
15991
|
100
|
|
|
|
27218
|
if ($bit != $prev) { |
498
|
9088
|
|
|
|
|
11439
|
$dir += $inc; |
499
|
9088
|
|
|
|
|
12230
|
$prev = $bit; |
500
|
|
|
|
|
|
|
} |
501
|
15991
|
|
|
|
|
22596
|
$inc = -$inc; # opposite at each bit |
502
|
|
|
|
|
|
|
} |
503
|
2000
|
|
|
|
|
2700
|
$dir &= 3; |
504
|
2000
|
|
|
|
|
2884
|
my $dx = $dir4_to_dx[$dir]; |
505
|
2000
|
|
|
|
|
2497
|
my $dy = $dir4_to_dy[$dir]; |
506
|
|
|
|
|
|
|
### $dx |
507
|
|
|
|
|
|
|
### $dy |
508
|
|
|
|
|
|
|
|
509
|
2000
|
50
|
|
|
|
3449
|
if ($n) { |
510
|
|
|
|
|
|
|
### apply fraction part: $n |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
# maybe: |
513
|
|
|
|
|
|
|
# +/- $n as dx or dy |
514
|
|
|
|
|
|
|
# +/- (1-$n) as other dy or dx |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# strip any low 1-bits, and the 0-bit above them |
517
|
|
|
|
|
|
|
# $inc is +1 at an even bit position or -1 at an odd bit position |
518
|
0
|
0
|
|
|
|
0
|
$inc = my $inc = ($arm & 1 ? -1 : 1); |
519
|
0
|
|
|
|
|
0
|
while (shift @bits) { |
520
|
0
|
|
|
|
|
0
|
$inc = -$inc; |
521
|
|
|
|
|
|
|
} |
522
|
0
|
0
|
|
|
|
0
|
if ($bits[0]) { # bit above lowest 0-bit, 1=right,0=left |
523
|
0
|
|
|
|
|
0
|
$inc = -$inc; |
524
|
|
|
|
|
|
|
} |
525
|
0
|
|
|
|
|
0
|
$dir += $inc; # apply turn to give $dir at $n+1 |
526
|
0
|
|
|
|
|
0
|
$dir &= 3; |
527
|
0
|
|
|
|
|
0
|
$dx += $n*($dir4_to_dx[$dir] - $dx); |
528
|
0
|
|
|
|
|
0
|
$dy += $n*($dir4_to_dy[$dir] - $dy); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
### result: "$dx, $dy" |
532
|
2000
|
|
|
|
|
5433
|
return ($dx,$dy); |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# { |
536
|
|
|
|
|
|
|
# sub print_table { |
537
|
|
|
|
|
|
|
# my ($name, $aref) = @_; |
538
|
|
|
|
|
|
|
# print "my \@$name = ("; |
539
|
|
|
|
|
|
|
# my $entry_width = max (map {length($_//'')} @$aref); |
540
|
|
|
|
|
|
|
# |
541
|
|
|
|
|
|
|
# foreach my $i (0 .. $#$aref) { |
542
|
|
|
|
|
|
|
# printf "%*s", $entry_width, $aref->[$i]//'undef'; |
543
|
|
|
|
|
|
|
# if ($i == $#$aref) { |
544
|
|
|
|
|
|
|
# print ");\n"; |
545
|
|
|
|
|
|
|
# } else { |
546
|
|
|
|
|
|
|
# print ","; |
547
|
|
|
|
|
|
|
# if (($i % 16) == 15 |
548
|
|
|
|
|
|
|
# || ($entry_width >= 3 && ($i % 4) == 3)) { |
549
|
|
|
|
|
|
|
# print "\n ".(" " x length($name)); |
550
|
|
|
|
|
|
|
# } elsif (($i % 4) == 3) { |
551
|
|
|
|
|
|
|
# print " "; |
552
|
|
|
|
|
|
|
# } |
553
|
|
|
|
|
|
|
# } |
554
|
|
|
|
|
|
|
# } |
555
|
|
|
|
|
|
|
# } |
556
|
|
|
|
|
|
|
# |
557
|
|
|
|
|
|
|
# my @next_state; |
558
|
|
|
|
|
|
|
# my @state_to_dxdy; |
559
|
|
|
|
|
|
|
# |
560
|
|
|
|
|
|
|
# sub make_state { |
561
|
|
|
|
|
|
|
# my %values = @_; |
562
|
|
|
|
|
|
|
# # if ($oddpos) { $rot = ($rot-1)&3; } |
563
|
|
|
|
|
|
|
# my $state = delete $values{'nextturn'}; |
564
|
|
|
|
|
|
|
# $state <<= 2; $state |= delete $values{'rot'}; |
565
|
|
|
|
|
|
|
# $state <<= 1; $state |= delete $values{'oddpos'}; |
566
|
|
|
|
|
|
|
# $state <<= 1; $state |= delete $values{'lowerbit'}; |
567
|
|
|
|
|
|
|
# $state <<= 1; $state |= delete $values{'bit'}; |
568
|
|
|
|
|
|
|
# die if %values; |
569
|
|
|
|
|
|
|
# return $state; |
570
|
|
|
|
|
|
|
# } |
571
|
|
|
|
|
|
|
# sub state_string { |
572
|
|
|
|
|
|
|
# my ($state) = @_; |
573
|
|
|
|
|
|
|
# my $bit = $state & 1; $state >>= 1; |
574
|
|
|
|
|
|
|
# my $lowerbit = $state & 1; $state >>= 1; |
575
|
|
|
|
|
|
|
# my $oddpos = $state & 1; $state >>= 1; |
576
|
|
|
|
|
|
|
# my $rot = $state & 3; $state >>= 2; |
577
|
|
|
|
|
|
|
# my $nextturn = $state; |
578
|
|
|
|
|
|
|
# # if ($oddpos) { $rot = ($rot+1)&3; } |
579
|
|
|
|
|
|
|
# return "rot=$rot,oddpos=$oddpos nextturn=$nextturn lowerbit=$lowerbit (bit=$bit)"; |
580
|
|
|
|
|
|
|
# } |
581
|
|
|
|
|
|
|
# |
582
|
|
|
|
|
|
|
# foreach my $nextturn (0, 1, 2) { |
583
|
|
|
|
|
|
|
# foreach my $rot (0, 1, 2, 3) { |
584
|
|
|
|
|
|
|
# foreach my $oddpos (0, 1) { |
585
|
|
|
|
|
|
|
# foreach my $lowerbit (0, 1) { |
586
|
|
|
|
|
|
|
# foreach my $bit (0, 1) { |
587
|
|
|
|
|
|
|
# my $state = make_state (bit => $bit, |
588
|
|
|
|
|
|
|
# lowerbit => $lowerbit, |
589
|
|
|
|
|
|
|
# rot => $rot, |
590
|
|
|
|
|
|
|
# oddpos => $oddpos, |
591
|
|
|
|
|
|
|
# nextturn => $nextturn); |
592
|
|
|
|
|
|
|
# ### $state |
593
|
|
|
|
|
|
|
# |
594
|
|
|
|
|
|
|
# my $new_nextturn = $nextturn; |
595
|
|
|
|
|
|
|
# my $new_lowerbit = $bit; |
596
|
|
|
|
|
|
|
# my $new_rot = $rot; |
597
|
|
|
|
|
|
|
# my $new_oddpos = $oddpos ^ 1; |
598
|
|
|
|
|
|
|
# |
599
|
|
|
|
|
|
|
# if ($bit != $lowerbit) { |
600
|
|
|
|
|
|
|
# if ($oddpos) { |
601
|
|
|
|
|
|
|
# $new_rot++; |
602
|
|
|
|
|
|
|
# } else { |
603
|
|
|
|
|
|
|
# $new_rot--; |
604
|
|
|
|
|
|
|
# } |
605
|
|
|
|
|
|
|
# $new_rot &= 3; |
606
|
|
|
|
|
|
|
# } |
607
|
|
|
|
|
|
|
# if ($lowerbit == 0 && ! $nextturn) { |
608
|
|
|
|
|
|
|
# $new_nextturn = ($bit ^ $oddpos ? 1 : 2); # bit above lowest 0 |
609
|
|
|
|
|
|
|
# } |
610
|
|
|
|
|
|
|
# |
611
|
|
|
|
|
|
|
# my $dx = 1; |
612
|
|
|
|
|
|
|
# my $dy = 0; |
613
|
|
|
|
|
|
|
# if ($rot & 2) { |
614
|
|
|
|
|
|
|
# $dx = -$dx; |
615
|
|
|
|
|
|
|
# $dy = -$dy; |
616
|
|
|
|
|
|
|
# } |
617
|
|
|
|
|
|
|
# if ($rot & 1) { |
618
|
|
|
|
|
|
|
# ($dx,$dy) = (-$dy,$dx); # rotate +90 |
619
|
|
|
|
|
|
|
# } |
620
|
|
|
|
|
|
|
# ### rot to: "$dx, $dy" |
621
|
|
|
|
|
|
|
# |
622
|
|
|
|
|
|
|
# # if ($oddpos) { |
623
|
|
|
|
|
|
|
# # ($dx,$dy) = (-$dy,$dx); # rotate +90 |
624
|
|
|
|
|
|
|
# # } else { |
625
|
|
|
|
|
|
|
# # ($dx,$dy) = ($dy,-$dx); # rotate -90 |
626
|
|
|
|
|
|
|
# # } |
627
|
|
|
|
|
|
|
# |
628
|
|
|
|
|
|
|
# my $next_dx = $dx; |
629
|
|
|
|
|
|
|
# my $next_dy = $dy; |
630
|
|
|
|
|
|
|
# if ($nextturn == 2) { |
631
|
|
|
|
|
|
|
# ($next_dx,$next_dy) = (-$next_dy,$next_dx); # left, rotate +90 |
632
|
|
|
|
|
|
|
# } else { |
633
|
|
|
|
|
|
|
# ($next_dx,$next_dy) = ($next_dy,-$next_dx); # right, rotate -90 |
634
|
|
|
|
|
|
|
# } |
635
|
|
|
|
|
|
|
# my $frac_dx = $next_dx - $dx; |
636
|
|
|
|
|
|
|
# my $frac_dy = $next_dy - $dy; |
637
|
|
|
|
|
|
|
# |
638
|
|
|
|
|
|
|
# # mask to rot,oddpos only, ignore bit,lowerbit |
639
|
|
|
|
|
|
|
# my $masked_state = $state & ~3; |
640
|
|
|
|
|
|
|
# $state_to_dxdy[$masked_state] = $dx; |
641
|
|
|
|
|
|
|
# $state_to_dxdy[$masked_state + 1] = $dy; |
642
|
|
|
|
|
|
|
# $state_to_dxdy[$masked_state + 2] = $frac_dx; |
643
|
|
|
|
|
|
|
# $state_to_dxdy[$masked_state + 3] = $frac_dy; |
644
|
|
|
|
|
|
|
# |
645
|
|
|
|
|
|
|
# my $next_state = make_state (bit => 0, |
646
|
|
|
|
|
|
|
# lowerbit => $new_lowerbit, |
647
|
|
|
|
|
|
|
# rot => $new_rot, |
648
|
|
|
|
|
|
|
# oddpos => $new_oddpos, |
649
|
|
|
|
|
|
|
# nextturn => $new_nextturn); |
650
|
|
|
|
|
|
|
# $next_state[$state] = $next_state; |
651
|
|
|
|
|
|
|
# } |
652
|
|
|
|
|
|
|
# } |
653
|
|
|
|
|
|
|
# } |
654
|
|
|
|
|
|
|
# } |
655
|
|
|
|
|
|
|
# } |
656
|
|
|
|
|
|
|
# |
657
|
|
|
|
|
|
|
# my @arm_to_state; |
658
|
|
|
|
|
|
|
# foreach my $arm (0 .. 7) { |
659
|
|
|
|
|
|
|
# my $rot = $arm >> 1; |
660
|
|
|
|
|
|
|
# my $oddpos = 0; |
661
|
|
|
|
|
|
|
# if ($arm & 1) { |
662
|
|
|
|
|
|
|
# $rot++; |
663
|
|
|
|
|
|
|
# $oddpos ^= 1; |
664
|
|
|
|
|
|
|
# } |
665
|
|
|
|
|
|
|
# $arm_to_state[$arm] = make_state (bit => 0, |
666
|
|
|
|
|
|
|
# lowerbit => 0, |
667
|
|
|
|
|
|
|
# rot => $rot, |
668
|
|
|
|
|
|
|
# oddpos => $oddpos, |
669
|
|
|
|
|
|
|
# nextturn => 0); |
670
|
|
|
|
|
|
|
# } |
671
|
|
|
|
|
|
|
# |
672
|
|
|
|
|
|
|
# ### @next_state |
673
|
|
|
|
|
|
|
# ### @state_to_dxdy |
674
|
|
|
|
|
|
|
# ### next_state length: 4*(4*2*2 + 4*2) |
675
|
|
|
|
|
|
|
# |
676
|
|
|
|
|
|
|
# print "# next_state length ", scalar(@next_state), "\n"; |
677
|
|
|
|
|
|
|
# print_table ("next_state", \@next_state); |
678
|
|
|
|
|
|
|
# print_table ("state_to_dxdy", \@state_to_dxdy); |
679
|
|
|
|
|
|
|
# print_table ("arm_to_state", \@arm_to_state); |
680
|
|
|
|
|
|
|
# print "\n"; |
681
|
|
|
|
|
|
|
# |
682
|
|
|
|
|
|
|
# foreach my $arm (0 .. 7) { |
683
|
|
|
|
|
|
|
# print "# arm=$arm ",state_string($arm_to_state[$arm]),"\n"; |
684
|
|
|
|
|
|
|
# } |
685
|
|
|
|
|
|
|
# print "\n"; |
686
|
|
|
|
|
|
|
# |
687
|
|
|
|
|
|
|
# |
688
|
|
|
|
|
|
|
# |
689
|
|
|
|
|
|
|
# use Smart::Comments; |
690
|
|
|
|
|
|
|
# |
691
|
|
|
|
|
|
|
# sub n_to_dxdy { |
692
|
|
|
|
|
|
|
# my ($self, $n) = @_; |
693
|
|
|
|
|
|
|
# ### n_to_dxdy(): $n |
694
|
|
|
|
|
|
|
# |
695
|
|
|
|
|
|
|
# my $int = int($n); |
696
|
|
|
|
|
|
|
# $n -= $int; # $n fraction part |
697
|
|
|
|
|
|
|
# ### $int |
698
|
|
|
|
|
|
|
# ### $n |
699
|
|
|
|
|
|
|
# |
700
|
|
|
|
|
|
|
# my $state = _divrem_mutate ($int, $self->{'arms'}) << 2; |
701
|
|
|
|
|
|
|
# ### arm as initial state: $state |
702
|
|
|
|
|
|
|
# |
703
|
|
|
|
|
|
|
# foreach my $bit (bit_split_lowtohigh($int)) { |
704
|
|
|
|
|
|
|
# $state = $next_state[$state + $bit]; |
705
|
|
|
|
|
|
|
# } |
706
|
|
|
|
|
|
|
# $state &= 0x1C; # mask out "prevbit" |
707
|
|
|
|
|
|
|
# |
708
|
|
|
|
|
|
|
# ### final state: $state |
709
|
|
|
|
|
|
|
# ### dx: $state_to_dxdy[$state] |
710
|
|
|
|
|
|
|
# ### dy: $state_to_dxdy[$state+1], |
711
|
|
|
|
|
|
|
# ### frac dx: $state_to_dxdy[$state+2], |
712
|
|
|
|
|
|
|
# ### frac dy: $state_to_dxdy[$state+3], |
713
|
|
|
|
|
|
|
# |
714
|
|
|
|
|
|
|
# return ($state_to_dxdy[$state] + $n * $state_to_dxdy[$state+2], |
715
|
|
|
|
|
|
|
# $state_to_dxdy[$state+1] + $n * $state_to_dxdy[$state+3]); |
716
|
|
|
|
|
|
|
# } |
717
|
|
|
|
|
|
|
# |
718
|
|
|
|
|
|
|
# } |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
721
|
|
|
|
|
|
|
# levels |
722
|
|
|
|
|
|
|
|
723
|
2
|
|
|
2
|
|
1285
|
use Math::PlanePath::DragonCurve; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
1843
|
|
724
|
|
|
|
|
|
|
*level_to_n_range = \&Math::PlanePath::DragonCurve::level_to_n_range; |
725
|
|
|
|
|
|
|
*n_to_level = \&Math::PlanePath::DragonCurve::n_to_level; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
sub _UNDOCUMENTED_level_to_right_line_boundary { |
730
|
0
|
|
|
0
|
|
|
my ($self, $level) = @_; |
731
|
0
|
0
|
|
|
|
|
if ($level == 0) { |
732
|
0
|
|
|
|
|
|
return 1; |
733
|
|
|
|
|
|
|
} |
734
|
0
|
|
|
|
|
|
my ($h,$odd) = _divrem($level,2); |
735
|
0
|
0
|
|
|
|
|
return ($odd |
736
|
|
|
|
|
|
|
? 6 * 2**$h - 4 |
737
|
|
|
|
|
|
|
: 2 * 2**$h); |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
sub _UNDOCUMENTED_level_to_left_line_boundary { |
740
|
0
|
|
|
0
|
|
|
my ($self, $level) = @_; |
741
|
0
|
0
|
|
|
|
|
if ($level == 0) { |
742
|
0
|
|
|
|
|
|
return 1; |
743
|
|
|
|
|
|
|
} |
744
|
0
|
|
|
|
|
|
my ($h,$odd) = _divrem($level,2); |
745
|
0
|
0
|
|
|
|
|
return ($odd |
746
|
|
|
|
|
|
|
? 2 * 2**$h |
747
|
|
|
|
|
|
|
: 4 * 2**$h - 4); |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
sub _UNDOCUMENTED_level_to_line_boundary { |
750
|
0
|
|
|
0
|
|
|
my ($self, $level) = @_; |
751
|
0
|
|
|
|
|
|
my ($h,$odd) = _divrem($level,2); |
752
|
0
|
0
|
|
|
|
|
return (($odd?8:6) * 2**$h - 4); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
sub _UNDOCUMENTED_level_to_hull_area { |
756
|
0
|
|
|
0
|
|
|
my ($self, $level) = @_; |
757
|
0
|
|
|
|
|
|
return (2**$level - 1)/2; |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub _UNDOCUMENTED__n_is_x_positive { |
761
|
0
|
|
|
0
|
|
|
my ($self, $n) = @_; |
762
|
0
|
0
|
0
|
|
|
|
if (! ($n >= 0) || is_infinite($n)) { return 0; } |
|
0
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
|
$n = int($n); |
765
|
|
|
|
|
|
|
{ |
766
|
0
|
|
|
|
|
|
my $arm = _divrem_mutate($n, $self->{'arms'}); |
|
0
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
# arm 1 good only on N=1 which is remaining $n==0 |
769
|
0
|
0
|
|
|
|
|
if ($arm == 1) { |
770
|
0
|
|
|
|
|
|
return ($n == 0); |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# arm 0 good |
774
|
|
|
|
|
|
|
# arm 8 good for N>=15 which is remaining $n>=1 |
775
|
0
|
0
|
0
|
|
|
|
unless ($arm == 0 |
|
|
|
0
|
|
|
|
|
776
|
|
|
|
|
|
|
|| ($arm == 7 && $n > 0)) { |
777
|
0
|
|
|
|
|
|
return 0; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
|
return _is_base4_01($n); |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub _UNDOCUMENTED__n_is_diagonal_NE { |
785
|
0
|
|
|
0
|
|
|
my ($self, $n) = @_; |
786
|
0
|
0
|
0
|
|
|
|
if (! ($n >= 0) || is_infinite($n)) { return 0; } |
|
0
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
|
788
|
0
|
|
|
|
|
|
$n = int($n); |
789
|
0
|
0
|
0
|
|
|
|
if ($self->{'arms'} >= 8 && $n == 15) { return 1; } |
|
0
|
|
|
|
|
|
|
790
|
0
|
0
|
|
|
|
|
if (_divrem_mutate($n, $self->{'arms'}) >= 2) { return 0; } |
|
0
|
|
|
|
|
|
|
791
|
0
|
|
|
|
|
|
return _is_base4_02($n); |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# X axis N is base4 digits 0,1 |
795
|
|
|
|
|
|
|
# and -1 from even is 0,1 low 0333333 |
796
|
|
|
|
|
|
|
# and -2 from even is 0,1 low 0333332 |
797
|
|
|
|
|
|
|
# so $n+2 low digit any then 0,1s above |
798
|
|
|
|
|
|
|
sub _UNDOCUMENTED__n_segment_is_right_boundary { |
799
|
0
|
|
|
0
|
|
|
my ($self, $n) = @_; |
800
|
0
|
0
|
0
|
|
|
|
if ($self->{'arms'} >= 8 |
|
|
|
0
|
|
|
|
|
801
|
|
|
|
|
|
|
|| ! ($n >= 0) |
802
|
|
|
|
|
|
|
|| is_infinite($n)) { |
803
|
0
|
|
|
|
|
|
return 0; |
804
|
|
|
|
|
|
|
} |
805
|
0
|
|
|
|
|
|
$n = int($n); |
806
|
|
|
|
|
|
|
|
807
|
0
|
0
|
|
|
|
|
if (_divrem_mutate($n, $self->{'arms'}) >= 1) { |
808
|
0
|
|
|
|
|
|
return 0; |
809
|
|
|
|
|
|
|
} |
810
|
0
|
|
|
|
|
|
$n += 2; |
811
|
0
|
|
|
|
|
|
_divrem_mutate($n,4); |
812
|
0
|
|
|
|
|
|
return _is_base4_01($n); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# diagonal N is base4 digits 0,2, |
816
|
|
|
|
|
|
|
# and -1 from there is 0,2 low 1 |
817
|
|
|
|
|
|
|
# or 0,2 low 13333 |
818
|
|
|
|
|
|
|
# so $n+1 low digit possible 1 or 3 then 0,2s above |
819
|
|
|
|
|
|
|
# which means $n+1 low digit any and 0,2s above |
820
|
|
|
|
|
|
|
#use Smart::Comments; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
sub _UNDOCUMENTED__n_segment_is_left_boundary { |
823
|
0
|
|
|
0
|
|
|
my ($self, $n) = @_; |
824
|
|
|
|
|
|
|
### _UNDOCUMENTED__n_segment_is_left_boundary(): $n |
825
|
|
|
|
|
|
|
|
826
|
0
|
|
|
|
|
|
my $arms = $self->{'arms'}; |
827
|
0
|
0
|
0
|
|
|
|
if ($arms >= 8 |
|
|
|
0
|
|
|
|
|
828
|
|
|
|
|
|
|
|| ! ($n >= 0) |
829
|
|
|
|
|
|
|
|| is_infinite($n)) { |
830
|
0
|
|
|
|
|
|
return 0; |
831
|
|
|
|
|
|
|
} |
832
|
0
|
|
|
|
|
|
$n = int($n); |
833
|
|
|
|
|
|
|
|
834
|
0
|
0
|
0
|
|
|
|
if (($n == 1 && $arms >= 4) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
835
|
|
|
|
|
|
|
|| ($n == 3 && $arms >= 5) |
836
|
|
|
|
|
|
|
|| ($n == 5 && $arms == 7)) { |
837
|
0
|
|
|
|
|
|
return 1; |
838
|
|
|
|
|
|
|
} |
839
|
0
|
0
|
|
|
|
|
if (_divrem_mutate($n, $arms) < $arms-1) { |
840
|
|
|
|
|
|
|
### no, not last arm ... |
841
|
0
|
|
|
|
|
|
return 0; |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
0
|
0
|
|
|
|
|
if ($arms % 2) { |
845
|
|
|
|
|
|
|
### odd arms, stair-step boundary ... |
846
|
0
|
|
|
|
|
|
$n += 1; |
847
|
0
|
|
|
|
|
|
_divrem_mutate($n,4); |
848
|
0
|
|
|
|
|
|
return _is_base4_02($n); |
849
|
|
|
|
|
|
|
} else { |
850
|
|
|
|
|
|
|
# even arms, notched like right boundary |
851
|
0
|
|
|
|
|
|
$n += 2; |
852
|
0
|
|
|
|
|
|
_divrem_mutate($n,4); |
853
|
0
|
|
|
|
|
|
return _is_base4_01($n); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub _is_base4_01 { |
858
|
0
|
|
|
0
|
|
|
my ($n) = @_; |
859
|
0
|
|
|
|
|
|
while ($n) { |
860
|
0
|
|
|
|
|
|
my $digit = _divrem_mutate($n,4); |
861
|
0
|
0
|
|
|
|
|
if ($digit >= 2) { return 0; } |
|
0
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
} |
863
|
0
|
|
|
|
|
|
return 1; |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
sub _is_base4_02 { |
866
|
0
|
|
|
0
|
|
|
my ($n) = @_; |
867
|
0
|
|
|
|
|
|
while ($n) { |
868
|
0
|
|
|
|
|
|
my $digit = _divrem_mutate($n,4); |
869
|
0
|
0
|
0
|
|
|
|
if ($digit == 1 || $digit == 3) { return 0; } |
|
0
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
} |
871
|
0
|
|
|
|
|
|
return 1; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
1; |
875
|
|
|
|
|
|
|
__END__ |