line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2012, 2013, 2014, 2015 Kevin Ryde |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This file is part of Math-PlanePath-Toothpick. |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Math-PlanePath-Toothpick is free software; you can redistribute it and/or |
6
|
|
|
|
|
|
|
# modify it under the terms of the GNU General Public License as published |
7
|
|
|
|
|
|
|
# by the Free Software Foundation; either version 3, or (at your option) any |
8
|
|
|
|
|
|
|
# later version. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Math-PlanePath-Toothpick is distributed in the hope that it will be |
11
|
|
|
|
|
|
|
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of |
12
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General |
13
|
|
|
|
|
|
|
# Public License for more details. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License along |
16
|
|
|
|
|
|
|
# with Math-PlanePath-Toothpick. If not, see . |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
20
|
|
|
|
|
|
|
# cf A153003 total cells 0, 1, 4, 7, 10 |
21
|
|
|
|
|
|
|
# A153004 added cells +1, 3, 3, 3, 6 |
22
|
|
|
|
|
|
|
# A153005 total which are primes |
23
|
|
|
|
|
|
|
# clipping parts=4 pattern to 3 quadrants, |
24
|
|
|
|
|
|
|
# X=0,Y=0 as a half toothpick not counted |
25
|
|
|
|
|
|
|
# X=0,Y=-1 as a half toothpick not counted |
26
|
|
|
|
|
|
|
# X=1,Y=-1 "root" would begin at depth=1, or count it as child of 1 |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# | | |
29
|
|
|
|
|
|
|
# 2---1---2 |
30
|
|
|
|
|
|
|
# | | | |
31
|
|
|
|
|
|
|
# X |
32
|
|
|
|
|
|
|
# | | |
33
|
|
|
|
|
|
|
# ---X---2 |
34
|
|
|
|
|
|
|
# | |
35
|
|
|
|
|
|
|
# |
36
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
37
|
|
|
|
|
|
|
# A160740 toothpick starting from 4 as cross |
38
|
|
|
|
|
|
|
# doesn't maintain XYeven=vertical, XYodd=horizontal |
39
|
|
|
|
|
|
|
# | |
40
|
|
|
|
|
|
|
# * |
41
|
|
|
|
|
|
|
# | |
42
|
|
|
|
|
|
|
# ---*--- ---*--- |
43
|
|
|
|
|
|
|
# | |
44
|
|
|
|
|
|
|
# * |
45
|
|
|
|
|
|
|
# | |
46
|
|
|
|
|
|
|
# A160426 cross with one long end for 5 initial toothpicks |
47
|
|
|
|
|
|
|
# A160730 right angle of 2 toothpicks |
48
|
|
|
|
|
|
|
# A168112 45-degree something related to 2 toothpick right-angle |
49
|
|
|
|
|
|
|
# A160732 T of 3 toothpicks |
50
|
|
|
|
|
|
|
# |
51
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
52
|
|
|
|
|
|
|
# cf A183004 toothpicks placed at ends, alternately vert,horiz |
53
|
|
|
|
|
|
|
# A183005 added 0,1,4,6,8,8,16,22,16,8,16, |
54
|
|
|
|
|
|
|
# |
55
|
|
|
|
|
|
|
# .-4-.-4-.-4-.-4- middle "3" touch two ends |
56
|
|
|
|
|
|
|
# 3 3 counts just once |
57
|
|
|
|
|
|
|
# . .-2-.-2-. |
58
|
|
|
|
|
|
|
# 3 1 3 |
59
|
|
|
|
|
|
|
# . .-2-.-2-. |
60
|
|
|
|
|
|
|
# 3 3 |
61
|
|
|
|
|
|
|
# .-4-.-4-.-4-.-4-. |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
64
|
|
|
|
|
|
|
# cf A160172 T-toothpick sequence |
65
|
|
|
|
|
|
|
# |
66
|
|
|
|
|
|
|
# A139250 total cells OFFSET=0 value=0 |
67
|
|
|
|
|
|
|
# a(2^k) = A007583(k) = (2^(2n+1) + 1)/3 |
68
|
|
|
|
|
|
|
# a(2^k-1) = A000969(2^k-2), A000969=floor (2*n+3)*(n+1)/3 |
69
|
|
|
|
|
|
|
# A139251 cells added |
70
|
|
|
|
|
|
|
# a(2^i)=2^i |
71
|
|
|
|
|
|
|
# a(2^i+j) = 2a(j)+a(j+1 |
72
|
|
|
|
|
|
|
# 0, 1, 2, |
73
|
|
|
|
|
|
|
# 4, 4, |
74
|
|
|
|
|
|
|
# 4, 8, 12, 8, |
75
|
|
|
|
|
|
|
# 4, 8, 12, 12, 16, 28, 32, 16, |
76
|
|
|
|
|
|
|
# 4, 8, 12, 12, 16, 28, 32, 20, 16, 28, 36, 40, 60, 88, 80, 32, |
77
|
|
|
|
|
|
|
# 4, 8, 12, 12, 16, 28, 32, 20, 16, 28, 36, 40, 60, 88, 80, 36, 16, 28, 36, 40, 60, 88, 84, 56, 60, 92, 112, 140, 208, 256, 192, 64, |
78
|
|
|
|
|
|
|
# 4, 8, 12, 12, 16, 28, 32, 20, 16, 28 |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# A160570 triangle, row sums are toothpick cumulative |
81
|
|
|
|
|
|
|
# A160552 a(2^i+j)=2*a(j)+a(j+1) starting 0,1 |
82
|
|
|
|
|
|
|
# A151548 A160552 row 2^k totals |
83
|
|
|
|
|
|
|
# A151549 half A151548 |
84
|
|
|
|
|
|
|
# A160762 convolution |
85
|
|
|
|
|
|
|
# |
86
|
|
|
|
|
|
|
# cf A160808 count cells Fibonacci spiral |
87
|
|
|
|
|
|
|
# A160809 cells added Fibonacci spiral |
88
|
|
|
|
|
|
|
# |
89
|
|
|
|
|
|
|
# A160164 "I"-toothpick |
90
|
|
|
|
|
|
|
# A187220 gull |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# "Q" |
93
|
|
|
|
|
|
|
# A187210, A211001-A211003, A211010, A211020-A211024. |
94
|
|
|
|
|
|
|
# A211011 |
95
|
|
|
|
|
|
|
# A210838 Coordinates (x,y) of the endpoint |
96
|
|
|
|
|
|
|
# A210841 Coordinates (x,y) of the endpoint |
97
|
|
|
|
|
|
|
# A211000 Coordinates (x,y) of the endpoint inflection at primes |
98
|
|
|
|
|
|
|
# http://www.njohnston.ca/2011/03/the-q-toothpick-cellular-automaton/ |
99
|
|
|
|
|
|
|
# maybe hearts A188346 == toothpicks A139250 |
100
|
|
|
|
|
|
|
# |
101
|
|
|
|
|
|
|
# T(level) = 4 * T(level-1) + 2 |
102
|
|
|
|
|
|
|
# T(level) = 2 * (4^level - 1) / 3 |
103
|
|
|
|
|
|
|
# total = T(level) + 2 |
104
|
|
|
|
|
|
|
# N = (4^level - 1)*2/3 |
105
|
|
|
|
|
|
|
# 4^level - 1 = 3*N/2 |
106
|
|
|
|
|
|
|
# 4^level = 3*N/2 + 1 |
107
|
|
|
|
|
|
|
# |
108
|
|
|
|
|
|
|
# len=2^level |
109
|
|
|
|
|
|
|
# total = (len*len-1)*2/3 + 2 |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# | | | |
113
|
|
|
|
|
|
|
# * -*- * -*- * |
114
|
|
|
|
|
|
|
# | | | |
115
|
|
|
|
|
|
|
# | | |
116
|
|
|
|
|
|
|
# -*- o -*- * -*- |
117
|
|
|
|
|
|
|
# | | |
118
|
|
|
|
|
|
|
# | | | |
119
|
|
|
|
|
|
|
# * -*- * -*- * |
120
|
|
|
|
|
|
|
# | | | |
121
|
|
|
|
|
|
|
# |
122
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
package Math::PlanePath::ToothpickTree; |
126
|
2
|
|
|
2
|
|
2346
|
use 5.004; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
64
|
|
127
|
2
|
|
|
2
|
|
9
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
54
|
|
128
|
2
|
|
|
2
|
|
7
|
use Carp 'croak'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
141
|
|
129
|
|
|
|
|
|
|
#use List::Util 'max','min'; |
130
|
|
|
|
|
|
|
*max = \&Math::PlanePath::_max; |
131
|
|
|
|
|
|
|
*min = \&Math::PlanePath::_min; |
132
|
|
|
|
|
|
|
|
133
|
2
|
|
|
2
|
|
7
|
use vars '$VERSION', '@ISA'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
90
|
|
134
|
|
|
|
|
|
|
$VERSION = 17; |
135
|
2
|
|
|
2
|
|
727
|
use Math::PlanePath; |
|
2
|
|
|
|
|
6394
|
|
|
2
|
|
|
|
|
56
|
|
136
|
|
|
|
|
|
|
@ISA = ('Math::PlanePath'); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
use Math::PlanePath::Base::Generic |
139
|
2
|
|
|
|
|
73
|
'is_infinite', |
140
|
2
|
|
|
2
|
|
11
|
'round_nearest'; |
|
2
|
|
|
|
|
2
|
|
141
|
|
|
|
|
|
|
use Math::PlanePath::Base::Digits |
142
|
2
|
|
|
2
|
|
518
|
'round_down_pow'; |
|
2
|
|
|
|
|
2058
|
|
|
2
|
|
|
|
|
105
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
145
|
|
|
|
|
|
|
# use Smart::Comments; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Note: some of this shared with ToothpickReplicate |
149
|
|
|
|
|
|
|
# |
150
|
2
|
|
|
2
|
|
11
|
use constant n_start => 0; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
171
|
|
151
|
2
|
|
|
|
|
96
|
use constant parameter_info_array => |
152
|
|
|
|
|
|
|
[ { name => 'parts', |
153
|
|
|
|
|
|
|
share_key => 'parts_toothpicktree', |
154
|
|
|
|
|
|
|
display => 'Parts', |
155
|
|
|
|
|
|
|
type => 'enum', |
156
|
|
|
|
|
|
|
default => '4', |
157
|
|
|
|
|
|
|
choices => ['4','3','2','1','octant','octant_up', |
158
|
|
|
|
|
|
|
'wedge','two_horiz', |
159
|
|
|
|
|
|
|
], |
160
|
|
|
|
|
|
|
choices_display => ['4','3','2','1','Octant','Octant Up', |
161
|
|
|
|
|
|
|
'Wedge','Two Horiz', |
162
|
|
|
|
|
|
|
], |
163
|
|
|
|
|
|
|
description => 'Which parts of the pattern to generate.', |
164
|
|
|
|
|
|
|
}, |
165
|
2
|
|
|
2
|
|
10
|
]; |
|
2
|
|
|
|
|
2
|
|
166
|
|
|
|
|
|
|
|
167
|
2
|
|
|
2
|
|
9
|
use constant class_x_negative => 1; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
70
|
|
168
|
2
|
|
|
2
|
|
8
|
use constant class_y_negative => 1; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
989
|
|
169
|
|
|
|
|
|
|
{ |
170
|
|
|
|
|
|
|
my %x_negative = (4 => 1, |
171
|
|
|
|
|
|
|
3 => 1, |
172
|
|
|
|
|
|
|
2 => 1, |
173
|
|
|
|
|
|
|
1 => 0, |
174
|
|
|
|
|
|
|
octant => 0, |
175
|
|
|
|
|
|
|
octant_up => 0, |
176
|
|
|
|
|
|
|
wedge => 1, |
177
|
|
|
|
|
|
|
'wedge+1' => 1, |
178
|
|
|
|
|
|
|
two_horiz => 1, |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
sub x_negative { |
181
|
1
|
|
|
1
|
1
|
46
|
my ($self) = @_; |
182
|
1
|
|
|
|
|
8
|
return $x_negative{$self->{'parts'}}; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
{ |
186
|
|
|
|
|
|
|
my %x_minimum = (1 => 1, |
187
|
|
|
|
|
|
|
octant => 1, |
188
|
|
|
|
|
|
|
octant_up => 1, |
189
|
|
|
|
|
|
|
# otherwise no minimum so undef |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
sub x_minimum { |
192
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
193
|
0
|
|
|
|
|
0
|
return $x_minimum{$self->{'parts'}}; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
{ |
197
|
|
|
|
|
|
|
my %y_negative = (4 => 1, |
198
|
|
|
|
|
|
|
3 => 1, |
199
|
|
|
|
|
|
|
2 => 0, |
200
|
|
|
|
|
|
|
1 => 0, |
201
|
|
|
|
|
|
|
octant => 0, |
202
|
|
|
|
|
|
|
octant_up => 0, |
203
|
|
|
|
|
|
|
wedge => 0, |
204
|
|
|
|
|
|
|
two_horiz => 1, |
205
|
|
|
|
|
|
|
); |
206
|
|
|
|
|
|
|
sub y_negative { |
207
|
1
|
|
|
1
|
1
|
4
|
my ($self) = @_; |
208
|
1
|
|
|
|
|
5
|
return $y_negative{$self->{'parts'}}; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
{ |
212
|
|
|
|
|
|
|
my %y_minimum = (2 => 1, |
213
|
|
|
|
|
|
|
1 => 1, |
214
|
|
|
|
|
|
|
octant => 1, |
215
|
|
|
|
|
|
|
octant_up => 2, |
216
|
|
|
|
|
|
|
wedge => 0, |
217
|
|
|
|
|
|
|
'wedge+1' => -1, |
218
|
|
|
|
|
|
|
# otherwise no minimum, undef |
219
|
|
|
|
|
|
|
); |
220
|
|
|
|
|
|
|
sub y_minimum { |
221
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
222
|
0
|
|
|
|
|
0
|
return $y_minimum{$self->{'parts'}}; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
{ |
227
|
|
|
|
|
|
|
my %x_negative_at_n = (4 => 4, |
228
|
|
|
|
|
|
|
3 => 5, |
229
|
|
|
|
|
|
|
2 => 2, |
230
|
|
|
|
|
|
|
1 => undef, |
231
|
|
|
|
|
|
|
octant => undef, |
232
|
|
|
|
|
|
|
octant_up => undef, |
233
|
|
|
|
|
|
|
wedge => 3, |
234
|
|
|
|
|
|
|
'wedge+1' => 1, |
235
|
|
|
|
|
|
|
two_horiz => 1, |
236
|
|
|
|
|
|
|
); |
237
|
|
|
|
|
|
|
sub x_negative_at_n { |
238
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
239
|
0
|
|
|
|
|
0
|
return $x_negative_at_n{$self->{'parts'}}; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
{ |
243
|
|
|
|
|
|
|
my %y_negative_at_n = (4 => 2, |
244
|
|
|
|
|
|
|
3 => 1, |
245
|
|
|
|
|
|
|
2 => undef, |
246
|
|
|
|
|
|
|
1 => undef, |
247
|
|
|
|
|
|
|
octant => undef, |
248
|
|
|
|
|
|
|
octant_up => undef, |
249
|
|
|
|
|
|
|
wedge => undef, |
250
|
|
|
|
|
|
|
'wedge+1' => 1, |
251
|
|
|
|
|
|
|
two_horiz => 4, |
252
|
|
|
|
|
|
|
); |
253
|
|
|
|
|
|
|
sub y_negative_at_n { |
254
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
255
|
0
|
|
|
|
|
0
|
return $y_negative_at_n{$self->{'parts'}}; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
{ |
260
|
|
|
|
|
|
|
my %sumxy_minimum = (1 => 2, # X=1,Y=1 |
261
|
|
|
|
|
|
|
octant => 2, # X=1,Y=1 |
262
|
|
|
|
|
|
|
octant_up => 3, # X=1,Y=2 |
263
|
|
|
|
|
|
|
wedge => 0, # X=0,Y=0 |
264
|
|
|
|
|
|
|
'wedge+1' => -1, |
265
|
|
|
|
|
|
|
# otherwise no minimum, undef |
266
|
|
|
|
|
|
|
); |
267
|
|
|
|
|
|
|
sub sumxy_minimum { |
268
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
269
|
0
|
|
|
|
|
0
|
return $sumxy_minimum{$self->{'parts'}}; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
my %sumabsxy_minimum = (2 => 1, # X=1,Y=0 |
274
|
|
|
|
|
|
|
1 => 2, # X=1,Y=1 |
275
|
|
|
|
|
|
|
octant => 2, # X=1,Y=1 |
276
|
|
|
|
|
|
|
octant_up => 3, # X=1,Y=2 |
277
|
|
|
|
|
|
|
wedge => 0, # X=0,Y=0 |
278
|
|
|
|
|
|
|
); |
279
|
|
|
|
|
|
|
sub sumabsxy_minimum { |
280
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
281
|
0
|
|
0
|
|
|
0
|
return ($sumabsxy_minimum{$self->{'parts'}} || 0); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
{ |
286
|
|
|
|
|
|
|
my %diffxy_minimum = (octant => -1, # X=1,Y=2 |
287
|
|
|
|
|
|
|
); |
288
|
|
|
|
|
|
|
sub diffxy_minimum { |
289
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
290
|
0
|
|
|
|
|
0
|
return $diffxy_minimum{$self->{'parts'}}; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
{ |
294
|
|
|
|
|
|
|
my %diffxy_maximum = (octant_up => 0, # Y>=X so X-Y<=0 |
295
|
|
|
|
|
|
|
wedge => 0, # Y>=X so X-Y<=0 |
296
|
|
|
|
|
|
|
'wedge+1' => 1, |
297
|
|
|
|
|
|
|
); |
298
|
|
|
|
|
|
|
sub diffxy_maximum { |
299
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
300
|
0
|
|
|
|
|
0
|
return $diffxy_maximum{$self->{'parts'}}; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
{ |
305
|
|
|
|
|
|
|
my %rsquared_minimum = (2 => 1, # X=0,Y=1 |
306
|
|
|
|
|
|
|
1 => 2, # X=1,Y=1 |
307
|
|
|
|
|
|
|
octant => 2, # X=1,Y=1 |
308
|
|
|
|
|
|
|
octant_up => 5, # X=1,Y=2 |
309
|
|
|
|
|
|
|
# otherwise 0 |
310
|
|
|
|
|
|
|
); |
311
|
|
|
|
|
|
|
sub rsquared_minimum { |
312
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
313
|
0
|
|
0
|
|
|
0
|
return ($rsquared_minimum{$self->{'parts'}} || 0); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
2
|
|
|
2
|
|
8
|
use constant tree_num_children_list => (0,1,2); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
7141
|
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# parts=1 Dir4 max 5,-4 |
320
|
|
|
|
|
|
|
# 14,-9 |
321
|
|
|
|
|
|
|
# 62,-33 |
322
|
|
|
|
|
|
|
# 126,-65 |
323
|
|
|
|
|
|
|
# 2*2^k-2, -2^k+1 -> 2,-1 |
324
|
|
|
|
|
|
|
# parts=3 same as parts=1 |
325
|
|
|
|
|
|
|
# |
326
|
|
|
|
|
|
|
# parts=4 dX=0,dY=-1 South, apparently |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
my %dir_maximum_dxdy = (4 => [0,-2], # at N=1 South dX=0,dY=-2 |
329
|
|
|
|
|
|
|
2 => [0,0], # supremum, dX=big,dY=-1 |
330
|
|
|
|
|
|
|
3 => [2,-1], # supremum |
331
|
|
|
|
|
|
|
1 => [2,-1], # supremum |
332
|
|
|
|
|
|
|
octant => [1,-2], # at N=4 |
333
|
|
|
|
|
|
|
octant_up => [0,-2], # at N=16 South |
334
|
|
|
|
|
|
|
wedge => [0,-2], # at N=35 South |
335
|
|
|
|
|
|
|
'wedge+1' => [0,0], # supremum, dX=big,dY=-1 |
336
|
|
|
|
|
|
|
two_horiz => [0,0], # supremum, dX=big,dY=-1 |
337
|
|
|
|
|
|
|
); |
338
|
|
|
|
|
|
|
sub dir_maximum_dxdy { |
339
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
340
|
0
|
|
|
|
|
0
|
return @{$dir_maximum_dxdy{$self->{'parts'}}}; |
|
0
|
|
|
|
|
0
|
|
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# add to $depth to give parts=4 style numbering |
347
|
|
|
|
|
|
|
my %parts_depth_adjust = (4 => 0, |
348
|
|
|
|
|
|
|
3 => 0, |
349
|
|
|
|
|
|
|
2 => 1, |
350
|
|
|
|
|
|
|
1 => 2, |
351
|
|
|
|
|
|
|
octant => 2, |
352
|
|
|
|
|
|
|
octant_up => 2, |
353
|
|
|
|
|
|
|
wedge => -1, |
354
|
|
|
|
|
|
|
# 'wedge+1' => 0, # not working |
355
|
|
|
|
|
|
|
two_horiz => 2, |
356
|
|
|
|
|
|
|
); |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub new { |
359
|
41
|
|
|
41
|
1
|
4098
|
my $self = shift->SUPER::new(@_); |
360
|
41
|
|
100
|
|
|
610
|
my $parts = ($self->{'parts'} ||= 4); |
361
|
41
|
50
|
|
|
|
125
|
if (! exists $parts_depth_adjust{$parts}) { |
362
|
0
|
|
|
|
|
0
|
croak "Unrecognised parts: ",$parts; |
363
|
|
|
|
|
|
|
} |
364
|
41
|
|
|
|
|
94
|
return $self; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
369
|
|
|
|
|
|
|
# n_to_xy() |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
my %initial_n_to_xy |
372
|
|
|
|
|
|
|
= (4 => [ [0,0], [0,1], [0,-1], [1,1], [-1,1], [-1,-1], [1,-1] ], |
373
|
|
|
|
|
|
|
3 => [ [0,0], [0,-1], [0,1], [1,-1], [1,1], [-1,1] ], |
374
|
|
|
|
|
|
|
2 => [ [0,1], [1,1], [-1,1] ], |
375
|
|
|
|
|
|
|
# 1 => [ ], |
376
|
|
|
|
|
|
|
# octant => [ ], |
377
|
|
|
|
|
|
|
# octant_up => [ ], |
378
|
|
|
|
|
|
|
wedge => [ [0,0], [0,1], [1,1],[-1,1] ], |
379
|
|
|
|
|
|
|
# 'wedge+1' => [ [0,0], [0,1],[0,-1], [1,1],[-1,1] ], |
380
|
|
|
|
|
|
|
two_horiz => [ [1,0],[-1,0], [2,0],[-2,0], |
381
|
|
|
|
|
|
|
[2,-1],[2,1],[-2,1],[-2,-1] ], |
382
|
|
|
|
|
|
|
); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub n_to_xy { |
385
|
319
|
|
|
319
|
1
|
7702
|
my ($self, $n) = @_; |
386
|
|
|
|
|
|
|
### ToothpickTree n_to_xy(): $n |
387
|
|
|
|
|
|
|
|
388
|
319
|
50
|
|
|
|
504
|
if ($n < 0) { return; } |
|
0
|
|
|
|
|
0
|
|
389
|
319
|
50
|
|
|
|
523
|
if (is_infinite($n)) { return ($n,$n); } |
|
0
|
|
|
|
|
0
|
|
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
{ |
392
|
319
|
|
|
|
|
1232
|
my $int = int($n); |
|
319
|
|
|
|
|
234
|
|
393
|
|
|
|
|
|
|
### $int |
394
|
|
|
|
|
|
|
### $n |
395
|
319
|
50
|
|
|
|
396
|
if ($n != $int) { |
396
|
0
|
|
|
|
|
0
|
my ($x1,$y1) = $self->n_to_xy($int); |
397
|
0
|
|
|
|
|
0
|
my ($x2,$y2) = $self->n_to_xy($int+1); |
398
|
0
|
|
|
|
|
0
|
my $frac = $n - $int; # inherit possible BigFloat |
399
|
0
|
|
|
|
|
0
|
my $dx = $x2-$x1; |
400
|
0
|
|
|
|
|
0
|
my $dy = $y2-$y1; |
401
|
0
|
|
|
|
|
0
|
return ($frac*$dx + $x1, $frac*$dy + $y1); |
402
|
|
|
|
|
|
|
} |
403
|
319
|
|
|
|
|
219
|
$n = $int; # BigFloat int() gives BigInt, use that |
404
|
|
|
|
|
|
|
} |
405
|
319
|
|
|
|
|
248
|
my $zero = $n*0; |
406
|
|
|
|
|
|
|
|
407
|
319
|
|
|
|
|
274
|
my $parts = $self->{'parts'}; |
408
|
|
|
|
|
|
|
|
409
|
319
|
100
|
|
|
|
515
|
if (my $initial = $initial_n_to_xy{$parts}) { |
410
|
238
|
100
|
|
|
|
349
|
if ($n <= $#$initial) { |
411
|
|
|
|
|
|
|
### initial_n_to_xy{}: $initial->[$n] |
412
|
32
|
|
|
|
|
23
|
return @{$initial->[$n]}; |
|
32
|
|
|
|
|
70
|
|
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
287
|
|
|
|
|
401
|
(my $depth, $n) = _n0_to_depth_and_rem($self, $n); |
417
|
|
|
|
|
|
|
### $depth |
418
|
|
|
|
|
|
|
### remainder n: $n |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# $hdx,$hdy is the dx,dy offsets which is "horizontal". Initially this is |
421
|
|
|
|
|
|
|
# hdx=1,hdy=0 so horizontal along the X axis, but subsequent blocks rotate |
422
|
|
|
|
|
|
|
# around or mirror to point other directions. |
423
|
|
|
|
|
|
|
# |
424
|
|
|
|
|
|
|
# $vdx,$vdy is similar dx,dy which is "vertical". Initially vdx=0,vdy=1 |
425
|
|
|
|
|
|
|
# so vertical along the Y axis. |
426
|
|
|
|
|
|
|
# |
427
|
|
|
|
|
|
|
# $mirror is true if in a "mirror image" block. The difference is that in |
428
|
|
|
|
|
|
|
# a plain block points are numbered around anti-clockwise, but when |
429
|
|
|
|
|
|
|
# mirrored they're numbered clockwise. |
430
|
|
|
|
|
|
|
# |
431
|
287
|
|
|
|
|
238
|
my $x = 0; |
432
|
287
|
|
|
|
|
188
|
my $y = 0; |
433
|
287
|
|
|
|
|
170
|
my $hdx = 1; |
434
|
287
|
|
|
|
|
176
|
my $hdy = 0; |
435
|
287
|
|
|
|
|
228
|
my $vdx = 0; |
436
|
287
|
|
|
|
|
220
|
my $vdy = 1; |
437
|
287
|
|
|
|
|
183
|
my $mirror = 0; |
438
|
287
|
|
|
|
|
263
|
$depth += $parts_depth_adjust{$parts}; |
439
|
|
|
|
|
|
|
### depth in parts=4 style: $depth |
440
|
|
|
|
|
|
|
|
441
|
287
|
50
|
|
|
|
687
|
if ($parts eq 'octant') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
} elsif ($parts eq 'octant_up') { |
444
|
0
|
|
|
|
|
0
|
$mirror = 1; |
445
|
0
|
|
|
|
|
0
|
$y = 1; |
446
|
0
|
|
|
|
|
0
|
$hdx = 0; $hdy = 1; # initial transpose X,Y |
|
0
|
|
|
|
|
0
|
|
447
|
0
|
|
|
|
|
0
|
$vdx = 1; $vdy = 0; |
|
0
|
|
|
|
|
0
|
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge') { |
450
|
0
|
|
|
|
|
0
|
$y = 1; |
451
|
0
|
|
|
|
|
0
|
$hdx = 0; $hdy = 1; $vdy = 0; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
452
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
453
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
454
|
|
|
|
|
|
|
# right half |
455
|
0
|
|
|
|
|
0
|
$mirror = 1; |
456
|
0
|
|
|
|
|
0
|
$vdx = 1; |
457
|
|
|
|
|
|
|
} else { |
458
|
|
|
|
|
|
|
# left half |
459
|
0
|
|
|
|
|
0
|
$n -= $add; |
460
|
0
|
|
|
|
|
0
|
$vdx = -1; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
} elsif ($parts eq 'two_horiz') { |
464
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
465
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
466
|
|
|
|
|
|
|
### first eighth ... |
467
|
0
|
|
|
|
|
0
|
$hdx = 0; $hdy = -1; $vdx = 1; $vdy = 0; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
468
|
0
|
|
|
|
|
0
|
$y = 1; |
469
|
|
|
|
|
|
|
} else { |
470
|
0
|
|
|
|
|
0
|
my $add3 = _depth_to_octant_added([$depth-3],[1],$zero); |
471
|
0
|
|
|
|
|
0
|
my $quad = $add + $add3 - 1; |
472
|
0
|
|
|
|
|
0
|
my $half = 2*$quad; |
473
|
|
|
|
|
|
|
### $add |
474
|
|
|
|
|
|
|
### $add3 |
475
|
|
|
|
|
|
|
### $quad |
476
|
|
|
|
|
|
|
### $half |
477
|
0
|
0
|
|
|
|
0
|
if ($n >= $half) { |
478
|
0
|
|
|
|
|
0
|
$n -= $half; |
479
|
0
|
|
|
|
|
0
|
$hdx = -1; $vdy = -1; # rotate 180 |
|
0
|
|
|
|
|
0
|
|
480
|
|
|
|
|
|
|
} |
481
|
0
|
0
|
|
|
|
0
|
if ($n < $quad) { |
482
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
483
|
|
|
|
|
|
|
### fifth octant ... |
484
|
0
|
|
|
|
|
0
|
$hdx = 0; $hdy = 1; $vdx = -1; $vdy = 0; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
485
|
0
|
|
|
|
|
0
|
$y = -1; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
} else { |
488
|
|
|
|
|
|
|
### second/sixth eighth ... |
489
|
0
|
|
|
|
|
0
|
$n -= $add - 1; # and unduplicate spine |
490
|
0
|
|
|
|
|
0
|
$x = 2*$hdx; |
491
|
0
|
|
|
|
|
0
|
$depth -= 3; |
492
|
0
|
|
|
|
|
0
|
$mirror = 1; |
493
|
0
|
|
|
|
|
0
|
$hdy = -$hdy; $vdy = -$vdy; # reflect across X axis |
|
0
|
|
|
|
|
0
|
|
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
} else { |
496
|
0
|
|
|
|
|
0
|
$n -= $quad; |
497
|
0
|
0
|
|
|
|
0
|
if ($n < $add3-1) { |
498
|
|
|
|
|
|
|
### third/seventh eighth ... |
499
|
0
|
|
|
|
|
0
|
$depth -= 3; |
500
|
0
|
|
|
|
|
0
|
$x = 2*$hdx; |
501
|
|
|
|
|
|
|
} else { |
502
|
|
|
|
|
|
|
### fourth/eighth eighth ... |
503
|
0
|
|
|
|
|
0
|
$n -= $add3-1; |
504
|
0
|
|
|
|
|
0
|
$y = -$vdy; |
505
|
0
|
|
|
|
|
0
|
$mirror = 1; |
506
|
0
|
|
|
|
|
0
|
($hdx,$hdy, $vdx,$vdy) = ($vdx,$vdy, $hdx,$hdy); # transpose X,Y |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
} else { |
512
|
287
|
|
|
|
|
632
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
513
|
|
|
|
|
|
|
### $add |
514
|
|
|
|
|
|
|
|
515
|
287
|
100
|
|
|
|
544
|
if ($parts eq '3') { |
516
|
59
|
|
|
|
|
97
|
my $add_plus1 = _depth_to_octant_added([$depth+1],[1],$zero); |
517
|
59
|
|
|
|
|
68
|
my $add_quad = $add_plus1 + $add - 1; |
518
|
|
|
|
|
|
|
### parts=3 lower quad: $add_quad |
519
|
59
|
100
|
|
|
|
67
|
if ($n < $add_quad) { |
520
|
|
|
|
|
|
|
### initial block 1, rotate 90 ... |
521
|
23
|
|
|
|
|
19
|
$depth += 1; |
522
|
23
|
|
|
|
|
16
|
$add = $add_plus1; |
523
|
23
|
|
|
|
|
70
|
$x = -1; |
524
|
23
|
|
|
|
|
14
|
$hdx = 0; $hdy = -1; $vdx = 1; $vdy = 0; |
|
23
|
|
|
|
|
14
|
|
|
23
|
|
|
|
|
22
|
|
|
23
|
|
|
|
|
25
|
|
525
|
23
|
|
|
|
|
28
|
$parts = '1'; |
526
|
|
|
|
|
|
|
} else { |
527
|
|
|
|
|
|
|
# now parts=2 style remaining |
528
|
36
|
|
|
|
|
48
|
$n -= $add_quad; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
287
|
100
|
|
|
|
399
|
if ($parts ne '1') { |
533
|
183
|
|
|
|
|
348
|
my $add_sub1 = _depth_to_octant_added([$depth-1], [1], $zero); |
534
|
183
|
|
|
|
|
222
|
my $add_quad = $add + $add_sub1 - 1; |
535
|
|
|
|
|
|
|
|
536
|
183
|
100
|
|
|
|
261
|
if ($parts eq '4') { |
537
|
85
|
|
|
|
|
91
|
my $add_half = 2*$add_quad; |
538
|
85
|
100
|
|
|
|
129
|
if ($n >= $add_half) { |
539
|
38
|
|
|
|
|
36
|
$n -= $add_half; |
540
|
38
|
|
|
|
|
32
|
$hdx = -1; $vdy = -1; # rotate 180 |
|
38
|
|
|
|
|
34
|
|
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# parts=2 style two quadrants |
545
|
183
|
100
|
|
|
|
396
|
if ($n >= $add_quad) { |
546
|
|
|
|
|
|
|
### second quadrant ... |
547
|
88
|
|
|
|
|
89
|
$n -= $add_quad; |
548
|
|
|
|
|
|
|
|
549
|
88
|
100
|
|
|
|
105
|
if ($n >= $add_sub1) { |
550
|
|
|
|
|
|
|
### fourth octant ... |
551
|
22
|
|
|
|
|
22
|
$n -= $add_sub1; |
552
|
22
|
|
|
|
|
18
|
$n += 1; # unduplicate diagonal |
553
|
22
|
|
|
|
|
19
|
$mirror = 1; |
554
|
22
|
|
|
|
|
21
|
$hdx = -$hdx; $hdy = -$hdy; # reflect horizontally |
|
22
|
|
|
|
|
14
|
|
555
|
|
|
|
|
|
|
} else { |
556
|
|
|
|
|
|
|
### third octant ... |
557
|
66
|
|
|
|
|
55
|
$depth -= 1; |
558
|
66
|
|
|
|
|
120
|
($hdx,$hdy, $vdx,$vdy) # rotate -90 |
559
|
|
|
|
|
|
|
= ($vdx,$vdy, -$hdx,-$hdy); |
560
|
66
|
|
|
|
|
60
|
$x += $hdx; |
561
|
66
|
|
|
|
|
61
|
$y += $hdy; |
562
|
|
|
|
|
|
|
} |
563
|
88
|
|
|
|
|
107
|
$add = $n+1; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
### first quadrant split: "add=$add n=$n depth=$depth" |
568
|
287
|
100
|
|
|
|
402
|
if ($n >= $add) { |
569
|
|
|
|
|
|
|
### top half of quad ... |
570
|
47
|
|
|
|
|
54
|
$depth -= 1; |
571
|
47
|
|
|
|
|
40
|
$n -= $add; |
572
|
47
|
|
|
|
|
61
|
$n += 1; # unduplicate diagonal |
573
|
47
|
|
|
|
|
52
|
$mirror ^= 1; |
574
|
47
|
|
|
|
|
32
|
$x += $vdx; |
575
|
47
|
|
|
|
|
38
|
$y += $vdy; |
576
|
47
|
|
|
|
|
78
|
($hdx,$hdy, $vdx,$vdy) # transpose X,Y |
577
|
|
|
|
|
|
|
= ($vdx,$vdy, $hdx,$hdy); |
578
|
|
|
|
|
|
|
### transpose to: "hdxy=$hdx,$hdy vdxy=$vdx,$vdy n=$n depth=$depth" |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
### in parts=4 style: "n=$n depth=$depth x=$x y=$y hdxy=$hdx,$hdy vdxy=$vdx,$vdy" |
582
|
|
|
|
|
|
|
|
583
|
287
|
|
|
|
|
480
|
my ($pow,$exp) = round_down_pow ($depth, 2); |
584
|
287
|
|
|
|
|
1878
|
for ( ; --$exp >= 0; $pow /=2) { |
585
|
|
|
|
|
|
|
### at: "pow=$pow depth=$depth n=$n mirror=$mirror xy=$x,$y h=$hdx,$hdy v=$vdx,$vdy" |
586
|
|
|
|
|
|
|
|
587
|
469
|
100
|
|
|
|
608
|
if ($depth < $pow) { |
588
|
|
|
|
|
|
|
### block 0 ... |
589
|
41
|
|
|
|
|
51
|
next; |
590
|
|
|
|
|
|
|
} |
591
|
428
|
|
|
|
|
287
|
$depth -= $pow; |
592
|
|
|
|
|
|
|
|
593
|
428
|
100
|
|
|
|
558
|
if ($depth == $pow-1) { |
594
|
|
|
|
|
|
|
### pow-1 end toothpick ... |
595
|
48
|
|
|
|
|
50
|
$x += $pow * ($hdx + $vdx) - $hdx; |
596
|
48
|
|
|
|
|
47
|
$y += $pow * ($hdy + $vdy) - $hdy; |
597
|
48
|
|
|
|
|
32
|
last; |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
380
|
|
|
|
|
348
|
$x += $pow/2 * ($hdx + $vdx); |
601
|
380
|
|
|
|
|
304
|
$y += $pow/2 * ($hdy + $vdy); |
602
|
|
|
|
|
|
|
### diagonal to: "depth=$depth xy=$x,$y" |
603
|
|
|
|
|
|
|
|
604
|
380
|
100
|
|
|
|
445
|
if ($depth == 0) { |
605
|
|
|
|
|
|
|
### toothpick A ... |
606
|
134
|
|
|
|
|
107
|
last; |
607
|
|
|
|
|
|
|
} |
608
|
246
|
100
|
|
|
|
305
|
if ($depth == 1) { |
609
|
|
|
|
|
|
|
### toothpick B,other up,down ... |
610
|
105
|
100
|
66
|
|
|
294
|
if ($exp && $n == $mirror) { |
611
|
|
|
|
|
|
|
### toothpick other (down): "subtract vdxdy=$vdx,$vdy" |
612
|
72
|
|
|
|
|
52
|
$x -= $vdx; |
613
|
72
|
|
|
|
|
68
|
$y -= $vdy; |
614
|
|
|
|
|
|
|
} else { |
615
|
|
|
|
|
|
|
### toothpick B (up): "add vdxdy=$vdx,$vdy" |
616
|
33
|
|
|
|
|
34
|
$x += $vdx; |
617
|
33
|
|
|
|
|
31
|
$y += $vdy; |
618
|
|
|
|
|
|
|
} |
619
|
105
|
|
|
|
|
87
|
last; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
141
|
100
|
|
|
|
175
|
if ($mirror) { |
623
|
|
|
|
|
|
|
# / |
624
|
|
|
|
|
|
|
# /3 |
625
|
|
|
|
|
|
|
# /-- |
626
|
|
|
|
|
|
|
# /|\2 |
627
|
|
|
|
|
|
|
# /0|1\ |
628
|
45
|
|
|
|
|
101
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
629
|
|
|
|
|
|
|
### add in mirror block2,3: $add |
630
|
|
|
|
|
|
|
|
631
|
45
|
100
|
|
|
|
98
|
if ($n < $add) { |
632
|
|
|
|
|
|
|
### mirror block 3, same ... |
633
|
3
|
|
|
|
|
7
|
next; |
634
|
|
|
|
|
|
|
} |
635
|
42
|
|
|
|
|
47
|
$n -= $add; |
636
|
|
|
|
|
|
|
|
637
|
42
|
100
|
|
|
|
85
|
if ($n < $add) { |
638
|
|
|
|
|
|
|
### mirror block 2, unmirror, vertical invert ... |
639
|
37
|
|
|
|
|
29
|
$vdx = -$vdx; |
640
|
37
|
|
|
|
|
49
|
$vdy = -$vdy; |
641
|
37
|
|
|
|
|
40
|
$mirror = 0; |
642
|
37
|
|
|
|
|
64
|
next; |
643
|
|
|
|
|
|
|
} |
644
|
5
|
|
|
|
|
6
|
$n -= $add; |
645
|
5
|
|
|
|
|
12
|
$n += 1; # undouble upper/lower diagonal |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
### mirror block 1, rotate 90 ... |
648
|
|
|
|
|
|
|
### assert: $n < _depth_to_octant_added([$depth+1],[1],$zero); |
649
|
5
|
|
|
|
|
4
|
$depth += 1; |
650
|
5
|
|
|
|
|
6
|
$x -= $hdx; # offset |
651
|
5
|
|
|
|
|
6
|
$y -= $hdy; |
652
|
5
|
|
|
|
|
16
|
($hdx,$hdy, $vdx,$vdy) # rotate 90 in direction v toward h |
653
|
|
|
|
|
|
|
= (-$vdx,-$vdy, $hdx,$hdy); |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
} else { |
656
|
|
|
|
|
|
|
### assert: $mirror==0 |
657
|
|
|
|
|
|
|
# / |
658
|
|
|
|
|
|
|
# /3 |
659
|
|
|
|
|
|
|
# /-- |
660
|
|
|
|
|
|
|
# /|\2 |
661
|
|
|
|
|
|
|
# /0|1\ |
662
|
|
|
|
|
|
|
|
663
|
96
|
50
|
|
|
|
177
|
if ($depth+1 < $pow) { |
664
|
96
|
|
|
|
|
197
|
my $add = _depth_to_octant_added([$depth+1],[1],$zero) - 1; |
665
|
|
|
|
|
|
|
### add in block1, sans diagonal: $add |
666
|
96
|
100
|
|
|
|
162
|
if ($n < $add) { |
667
|
|
|
|
|
|
|
### block 1 "lower", rotate +90 ... |
668
|
7
|
|
|
|
|
9
|
$depth += 1; |
669
|
7
|
|
|
|
|
8
|
$x -= $hdx; # offset |
670
|
7
|
|
|
|
|
7
|
$y -= $hdy; |
671
|
7
|
|
|
|
|
11
|
($hdx,$hdy, $vdx,$vdy) # rotate 90 in direction v toward h |
672
|
|
|
|
|
|
|
= (-$vdx,-$vdy, $hdx,$hdy); |
673
|
7
|
|
|
|
|
14
|
next; |
674
|
|
|
|
|
|
|
} |
675
|
89
|
|
|
|
|
71
|
$n -= $add; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
89
|
|
|
|
|
148
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
679
|
|
|
|
|
|
|
### add in block2: $add |
680
|
|
|
|
|
|
|
|
681
|
89
|
100
|
|
|
|
161
|
if ($n < $add) { |
682
|
|
|
|
|
|
|
### block 2 "upper", vertical invert ... |
683
|
47
|
|
|
|
|
53
|
$vdx = -$vdx; |
684
|
47
|
|
|
|
|
51
|
$vdy = -$vdy; |
685
|
47
|
|
|
|
|
93
|
$mirror = 1; |
686
|
|
|
|
|
|
|
} else { |
687
|
|
|
|
|
|
|
### block 3 "extend", same ... |
688
|
42
|
|
|
|
|
85
|
$n -= $add; |
689
|
|
|
|
|
|
|
### assert: $n < $add |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
### n_to_xy() return: "$x,$y (depth=$depth n=$n)" |
695
|
287
|
|
|
|
|
529
|
return ($x,$y); |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
sub xy_to_n { |
699
|
252
|
|
|
252
|
1
|
4442
|
my ($self, $x, $y) = @_; |
700
|
|
|
|
|
|
|
### ToothpickTree xy_to_n(): "$x, $y" |
701
|
|
|
|
|
|
|
|
702
|
252
|
|
|
|
|
410
|
$x = round_nearest ($x); |
703
|
252
|
|
|
|
|
1146
|
$y = round_nearest ($y); |
704
|
|
|
|
|
|
|
|
705
|
252
|
|
|
|
|
838
|
my $zero = $x * 0 * $y; |
706
|
252
|
|
|
|
|
172
|
my $n = $zero; |
707
|
252
|
|
|
|
|
156
|
my @add_offset; |
708
|
|
|
|
|
|
|
my @add_mult; |
709
|
252
|
|
|
|
|
186
|
my $mirror = 0; |
710
|
252
|
|
|
|
|
165
|
my $depth = 0; |
711
|
252
|
|
|
|
|
178
|
my $depth_adjust = 0; |
712
|
|
|
|
|
|
|
|
713
|
252
|
|
|
|
|
239
|
my $parts = $self->{'parts'}; |
714
|
|
|
|
|
|
|
|
715
|
252
|
50
|
|
|
|
612
|
if ($parts eq 'octant') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
716
|
|
|
|
|
|
|
# if ($x < 1 || $y < 1 || $y > $x+1) { return undef; } |
717
|
0
|
|
|
|
|
0
|
$depth_adjust = 2; |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
} elsif ($parts eq 'octant_up') { |
720
|
|
|
|
|
|
|
# if ($x > $y || $x < 1 || $y < 2) { return undef; } |
721
|
0
|
|
|
|
|
0
|
($x,$y) = ($y-1,$x); |
722
|
0
|
|
|
|
|
0
|
$mirror = 1; |
723
|
0
|
|
|
|
|
0
|
$depth_adjust = 2; |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge') { |
726
|
0
|
0
|
0
|
|
|
0
|
if ($x > $y || $x < -$y) { return undef; } |
|
0
|
|
|
|
|
0
|
|
727
|
0
|
|
|
|
|
0
|
$depth_adjust = -1; |
728
|
0
|
|
|
|
|
0
|
$y -= 1; |
729
|
0
|
0
|
|
|
|
0
|
if ($y <= 0) { |
730
|
0
|
0
|
|
|
|
0
|
if ($y < 0) { return 0; } # X=0,Y=0 N=0 |
|
0
|
|
|
|
|
0
|
|
731
|
|
|
|
|
|
|
# otherwise Y=1 |
732
|
0
|
0
|
|
|
|
0
|
if ($x == 0) { return 1; } |
|
0
|
|
|
|
|
0
|
|
733
|
0
|
0
|
|
|
|
0
|
if ($x == 1) { return 2; } |
|
0
|
|
|
|
|
0
|
|
734
|
0
|
0
|
|
|
|
0
|
if ($x == -1) { return 3; } |
|
0
|
|
|
|
|
0
|
|
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
0
|
0
|
|
|
|
0
|
if ($x >= 0) { |
738
|
|
|
|
|
|
|
### wedge X positive half, transpose ... |
739
|
0
|
|
|
|
|
0
|
($x,$y) = ($y,$x); |
740
|
0
|
|
|
|
|
0
|
$mirror = 1; |
741
|
|
|
|
|
|
|
} else { |
742
|
|
|
|
|
|
|
### wedge X negative half, rotate -90 ... |
743
|
0
|
|
|
|
|
0
|
($x,$y) = ($y,-$x); # rotate -90 |
744
|
0
|
|
|
|
|
0
|
push @add_offset, 0; |
745
|
0
|
|
|
|
|
0
|
push @add_mult, 1; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
### wedge: "x=$x y=$y" |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
} elsif ($parts eq 'two_horiz') { |
750
|
0
|
0
|
0
|
|
|
0
|
if ($x == -1 && $y == 0) { return 1; } |
|
0
|
|
|
|
|
0
|
|
751
|
0
|
0
|
0
|
|
|
0
|
if ($x == -2 && $y == 0) { return 3; } |
|
0
|
|
|
|
|
0
|
|
752
|
|
|
|
|
|
|
|
753
|
0
|
|
|
|
|
0
|
my $mult = 0; |
754
|
0
|
|
|
|
|
0
|
my $mult3 = 0; |
755
|
0
|
0
|
|
|
|
0
|
if ($x < 0) { |
756
|
0
|
|
|
|
|
0
|
$x = -$x; $y = -$y; # rotate 180 |
|
0
|
|
|
|
|
0
|
|
757
|
0
|
|
|
|
|
0
|
$mult = 2; |
758
|
0
|
|
|
|
|
0
|
$mult3 = 2; |
759
|
0
|
|
|
|
|
0
|
$n -= 2; # unduplicate shared diagonals in first two quarters |
760
|
|
|
|
|
|
|
### rotate 180 to: "$x,$y" |
761
|
|
|
|
|
|
|
} |
762
|
0
|
0
|
|
|
|
0
|
if ($y > 0) { |
763
|
0
|
|
|
|
|
0
|
$mult++; |
764
|
0
|
|
|
|
|
0
|
$mult3++; |
765
|
0
|
|
|
|
|
0
|
$n -= 1; # unduplicate shared diagonal in first quarter |
766
|
0
|
0
|
|
|
|
0
|
if ($x < $y+2) { |
767
|
|
|
|
|
|
|
### fourth/eighth eighth ... |
768
|
0
|
|
|
|
|
0
|
$depth_adjust = 2; |
769
|
0
|
|
|
|
|
0
|
$mult3++; |
770
|
0
|
|
|
|
|
0
|
$n -= 1; # unduplicate shared diagonal |
771
|
0
|
|
|
|
|
0
|
($x,$y) = ($y+1,$x); # transpose and offset |
772
|
0
|
|
|
|
|
0
|
$mirror = 1; |
773
|
|
|
|
|
|
|
} else { |
774
|
|
|
|
|
|
|
### third/seventh eighth ... |
775
|
0
|
|
|
|
|
0
|
$x -= 2; |
776
|
0
|
|
|
|
|
0
|
$depth_adjust = -1; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
} else { # $y < 0 |
779
|
0
|
0
|
|
|
|
0
|
if ($x > 2-$y) { |
780
|
|
|
|
|
|
|
### second/sixth eighth ... |
781
|
0
|
|
|
|
|
0
|
$y = -$y; # mirror across X axis |
782
|
0
|
|
|
|
|
0
|
$x -= 2; |
783
|
0
|
|
|
|
|
0
|
$mirror = 1; |
784
|
0
|
|
|
|
|
0
|
$mult++; |
785
|
0
|
|
|
|
|
0
|
$n -= 1; # unduplicate shared diagonal |
786
|
0
|
|
|
|
|
0
|
$depth_adjust = -1; |
787
|
|
|
|
|
|
|
} else { |
788
|
|
|
|
|
|
|
### first/fifth eighth ... |
789
|
0
|
|
|
|
|
0
|
($x,$y) = (1-$y,$x); # rotate +90 and offset |
790
|
0
|
|
|
|
|
0
|
$depth_adjust = 2; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
} |
793
|
0
|
0
|
|
|
|
0
|
if ($mult) { |
794
|
0
|
|
|
|
|
0
|
push @add_offset, $depth_adjust - 2; |
795
|
0
|
|
|
|
|
0
|
push @add_mult, $mult; |
796
|
0
|
0
|
|
|
|
0
|
if ($mult3) { |
797
|
0
|
|
|
|
|
0
|
push @add_offset, $depth_adjust + 1; |
798
|
0
|
|
|
|
|
0
|
push @add_mult, $mult3; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
} else { |
803
|
|
|
|
|
|
|
|
804
|
252
|
100
|
|
|
|
393
|
if ($parts eq '1') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
805
|
51
|
50
|
33
|
|
|
155
|
if ($x < 1 || $y < 1) { return undef; } |
|
0
|
|
|
|
|
0
|
|
806
|
51
|
|
|
|
|
40
|
$depth_adjust = 2; |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
} elsif ($parts eq '2') { |
809
|
51
|
50
|
|
|
|
87
|
if ($y < 1) { return undef; } |
|
0
|
|
|
|
|
0
|
|
810
|
51
|
100
|
|
|
|
69
|
if ($x == 0) { |
811
|
1
|
50
|
|
|
|
3
|
if ($y == 1) { return 0; } |
|
1
|
|
|
|
|
3
|
|
812
|
|
|
|
|
|
|
} |
813
|
50
|
100
|
|
|
|
68
|
if ($y == 1) { |
814
|
8
|
100
|
|
|
|
15
|
if ($x == 1) { return 1; } |
|
1
|
|
|
|
|
2
|
|
815
|
7
|
100
|
|
|
|
20
|
if ($x == -1) { return 2; } |
|
1
|
|
|
|
|
2
|
|
816
|
|
|
|
|
|
|
} |
817
|
48
|
|
|
|
|
37
|
$depth_adjust = 1; |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
} elsif ($parts eq '3') { |
820
|
51
|
100
|
|
|
|
77
|
if ($x == 0) { |
821
|
5
|
100
|
|
|
|
9
|
if ($y == 0) { return 0; } |
|
1
|
|
|
|
|
2
|
|
822
|
4
|
100
|
|
|
|
10
|
if ($y == -1) { return 1; } |
|
1
|
|
|
|
|
2
|
|
823
|
3
|
100
|
|
|
|
6
|
if ($y == 1) { return 2; } |
|
1
|
|
|
|
|
2
|
|
824
|
|
|
|
|
|
|
} |
825
|
48
|
100
|
|
|
|
61
|
if ($y < 0) { |
826
|
18
|
50
|
|
|
|
31
|
if ($x < 0) { |
827
|
0
|
|
|
|
|
0
|
return undef; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
### parts=3 rotate +90 ... |
830
|
18
|
|
|
|
|
24
|
($x,$y) = (-$y,$x+1); |
831
|
18
|
|
|
|
|
17
|
$depth_adjust = 1; |
832
|
|
|
|
|
|
|
} else { |
833
|
30
|
|
|
|
|
35
|
push @add_offset, -1,0; # one quadrant |
834
|
30
|
|
|
|
|
26
|
push @add_mult, 1,1; |
835
|
30
|
|
|
|
|
35
|
$n -= 1; # unduplicate shared diagonal |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
} else { |
839
|
|
|
|
|
|
|
### assert: $parts eq '4' |
840
|
99
|
100
|
|
|
|
133
|
if ($x == 0) { |
841
|
6
|
100
|
|
|
|
9
|
if ($y == 0) { return 0; } |
|
2
|
|
|
|
|
4
|
|
842
|
4
|
100
|
|
|
|
9
|
if ($y == 1) { return 1; } |
|
2
|
|
|
|
|
9
|
|
843
|
2
|
50
|
|
|
|
5
|
if ($y == -1) { return 2; } |
|
2
|
|
|
|
|
4
|
|
844
|
|
|
|
|
|
|
} |
845
|
93
|
100
|
|
|
|
147
|
if ($y < 0) { |
846
|
42
|
|
|
|
|
39
|
$x = -$x; $y = -$y; # rotate 180 |
|
42
|
|
|
|
|
31
|
|
847
|
42
|
|
|
|
|
42
|
push @add_offset, 0,1; # two quadrants |
848
|
42
|
|
|
|
|
34
|
push @add_mult, 2,2; |
849
|
42
|
|
|
|
|
36
|
$n -= 2; # unduplicate shared diagonal |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
240
|
100
|
|
|
|
328
|
if ($x < 0) { |
854
|
|
|
|
|
|
|
### X negative mirror ... |
855
|
82
|
|
|
|
|
73
|
$x = -$x; |
856
|
82
|
|
|
|
|
69
|
$mirror = 1; |
857
|
82
|
|
|
|
|
81
|
push @add_offset, 0,1; # one quadrant |
858
|
82
|
|
|
|
|
74
|
push @add_mult, 1,1; |
859
|
82
|
|
|
|
|
73
|
$n -= 1; # unduplicate shared diagonal |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
240
|
100
|
|
|
|
268
|
if ($y <= $x) { |
863
|
|
|
|
|
|
|
### lower octant ... |
864
|
126
|
100
|
|
|
|
181
|
if ($mirror) { |
865
|
42
|
|
|
|
|
35
|
push @add_offset, 1; |
866
|
42
|
|
|
|
|
63
|
push @add_mult, 1; |
867
|
42
|
|
|
|
|
35
|
$n -= 1; # unduplicate shared diagonal |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
} else { |
870
|
|
|
|
|
|
|
### upper octant ... |
871
|
114
|
|
|
|
|
163
|
($x,$y) = ($y-1,$x); |
872
|
114
|
|
|
|
|
264
|
foreach (@add_offset) { $_-- } |
|
148
|
|
|
|
|
128
|
|
873
|
114
|
|
|
|
|
102
|
$depth_adjust--; |
874
|
114
|
100
|
|
|
|
175
|
if (! $mirror) { |
875
|
74
|
|
|
|
|
80
|
push @add_offset, -1; |
876
|
74
|
|
|
|
|
64
|
push @add_mult, 1; |
877
|
74
|
|
|
|
|
66
|
$n -= 1; # unduplicate shared diagonal |
878
|
|
|
|
|
|
|
} |
879
|
114
|
|
|
|
|
123
|
$mirror ^= 1; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
### $depth_adjust |
883
|
|
|
|
|
|
|
### xy: "$x,$y" |
884
|
|
|
|
|
|
|
|
885
|
240
|
50
|
33
|
|
|
1049
|
if ($x < 1|| $y < 1 || $y > $x+1) { |
|
|
|
33
|
|
|
|
|
886
|
0
|
|
|
|
|
0
|
return undef; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
|
889
|
240
|
|
|
|
|
479
|
my ($pow,$exp) = round_down_pow (max($x,$y-1), 2); |
890
|
240
|
|
|
|
|
2702
|
$pow *= 2; |
891
|
240
|
50
|
|
|
|
363
|
if (is_infinite($exp)) { |
892
|
0
|
|
|
|
|
0
|
return ($exp); |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# / |
896
|
|
|
|
|
|
|
# /3 |
897
|
|
|
|
|
|
|
# /-- |
898
|
|
|
|
|
|
|
# /|\2 |
899
|
|
|
|
|
|
|
# /0|1\ |
900
|
|
|
|
|
|
|
|
901
|
240
|
|
|
|
|
875
|
for (;;) { |
902
|
|
|
|
|
|
|
### at: "x=$x,y=$y pow=$pow depth=$depth mirror=$mirror n=$n" |
903
|
|
|
|
|
|
|
### assert: $x >= 1 |
904
|
|
|
|
|
|
|
### assert: $y >= 1 || $y!=$y |
905
|
|
|
|
|
|
|
### assert: $y <= $x+1 || $y!=$y |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
# if ($x == $pow) { |
908
|
|
|
|
|
|
|
# if ($y == $pow) { |
909
|
|
|
|
|
|
|
# } |
910
|
|
|
|
|
|
|
# if ($y == $pow+1) { |
911
|
|
|
|
|
|
|
# ### toothpick B, stop ... |
912
|
|
|
|
|
|
|
# $depth += 2*$pow - 1; |
913
|
|
|
|
|
|
|
# $n += 1-$mirror; # "other" first if not mirrored |
914
|
|
|
|
|
|
|
# last; |
915
|
|
|
|
|
|
|
# } |
916
|
|
|
|
|
|
|
# if ($y == $pow-1) { |
917
|
|
|
|
|
|
|
# ### toothpick other, stop ... |
918
|
|
|
|
|
|
|
# $depth += 2*$pow - 1; |
919
|
|
|
|
|
|
|
# $n += $mirror; # B first if not mirrored |
920
|
|
|
|
|
|
|
# last; |
921
|
|
|
|
|
|
|
# } |
922
|
|
|
|
|
|
|
# } |
923
|
|
|
|
|
|
|
|
924
|
526
|
100
|
|
|
|
511
|
if ($x < $pow) { |
925
|
267
|
50
|
33
|
|
|
447
|
if ($y == $pow && $x == $pow-1) { |
926
|
|
|
|
|
|
|
### toothpick A, stop ... |
927
|
0
|
|
|
|
|
0
|
$depth += 2*$pow - 1; |
928
|
0
|
|
|
|
|
0
|
last; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
### block 0, no action ... |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
} else { |
933
|
259
|
|
|
|
|
168
|
$x -= $pow; |
934
|
259
|
|
|
|
|
190
|
$y -= $pow; |
935
|
259
|
|
|
|
|
192
|
$depth += 2*$pow; |
936
|
|
|
|
|
|
|
|
937
|
259
|
100
|
|
|
|
420
|
if ($y == 0) { |
|
|
100
|
|
|
|
|
|
938
|
67
|
50
|
|
|
|
80
|
if ($x == 0) { |
939
|
|
|
|
|
|
|
### toothpick B, stop ... |
940
|
67
|
|
|
|
|
56
|
last; |
941
|
|
|
|
|
|
|
} else { |
942
|
0
|
|
|
|
|
0
|
return undef; |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} elsif ($y > 0) { |
946
|
|
|
|
|
|
|
### block 3, same ... |
947
|
57
|
50
|
66
|
|
|
210
|
if ($y == 1 && $x == 0) { |
948
|
|
|
|
|
|
|
### middle above point, stop ... |
949
|
0
|
|
|
|
|
0
|
$depth += 1; |
950
|
0
|
0
|
|
|
|
0
|
if (! $mirror) { |
951
|
0
|
|
|
|
|
0
|
$n += 1; |
952
|
|
|
|
|
|
|
} |
953
|
0
|
|
|
|
|
0
|
last; |
954
|
|
|
|
|
|
|
} |
955
|
57
|
100
|
|
|
|
102
|
if (! $mirror) { |
956
|
30
|
|
|
|
|
47
|
push @add_offset, $depth-1, $depth; # past block 1,2 |
957
|
30
|
|
|
|
|
33
|
push @add_mult, 1, 1; |
958
|
30
|
|
|
|
|
37
|
$n -= 1; # unduplicate shared diagonal |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
} else { |
962
|
135
|
100
|
100
|
|
|
362
|
if ($y == -1 && $x == 0) { |
963
|
|
|
|
|
|
|
### middle below point, stop ... |
964
|
56
|
|
|
|
|
47
|
$depth += 1; |
965
|
56
|
100
|
|
|
|
105
|
if ($mirror) { |
966
|
28
|
|
|
|
|
22
|
$n += 1; |
967
|
|
|
|
|
|
|
} |
968
|
56
|
|
|
|
|
60
|
last; |
969
|
|
|
|
|
|
|
} |
970
|
79
|
100
|
|
|
|
134
|
if ($x >= -$y) { |
971
|
|
|
|
|
|
|
### block 2, vertical flip mirror ... |
972
|
59
|
50
|
|
|
|
107
|
if ($y > -1) { |
973
|
0
|
|
|
|
|
0
|
return undef; # no such point |
974
|
|
|
|
|
|
|
} |
975
|
59
|
|
|
|
|
111
|
$y = -$y; |
976
|
59
|
100
|
|
|
|
90
|
if ($mirror) { |
977
|
28
|
|
|
|
|
30
|
push @add_offset, $depth; # past block 3 |
978
|
28
|
|
|
|
|
27
|
push @add_mult, 1; |
979
|
|
|
|
|
|
|
} else { |
980
|
31
|
|
|
|
|
40
|
push @add_offset, $depth-1; # past block 1 |
981
|
31
|
|
|
|
|
39
|
push @add_mult, 1; |
982
|
31
|
|
|
|
|
39
|
$n -= 1; # unduplicate shared diagonal |
983
|
|
|
|
|
|
|
} |
984
|
59
|
|
|
|
|
74
|
$mirror ^= 1; |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
} else { |
987
|
|
|
|
|
|
|
### block 1, rotate and offset ... |
988
|
20
|
|
|
|
|
21
|
$depth -= 1; |
989
|
20
|
|
|
|
|
35
|
($x,$y) = (-$y,$x+1); # rotate +90, offset |
990
|
20
|
100
|
|
|
|
37
|
if ($mirror) { |
991
|
8
|
|
|
|
|
9
|
push @add_offset, $depth+1; # past block 3,2 |
992
|
8
|
|
|
|
|
7
|
push @add_mult, 2; |
993
|
8
|
|
|
|
|
8
|
$n -= 1; # unduplicate shared diagonal 2,1 |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
|
999
|
403
|
100
|
|
|
|
512
|
if (--$exp < 0) { |
1000
|
|
|
|
|
|
|
### final xy: "$x,$y" |
1001
|
117
|
50
|
33
|
|
|
320
|
if ($x == 1 && $y == 1) { |
|
|
0
|
0
|
|
|
|
|
1002
|
117
|
|
|
|
|
97
|
$depth += 2; |
1003
|
|
|
|
|
|
|
} elsif ($x == 1 && $y == 2) { |
1004
|
0
|
|
|
|
|
0
|
$depth += 3; |
1005
|
|
|
|
|
|
|
} else { |
1006
|
|
|
|
|
|
|
### not in final position ... |
1007
|
0
|
|
|
|
|
0
|
return undef; |
1008
|
|
|
|
|
|
|
} |
1009
|
117
|
|
|
|
|
97
|
last; |
1010
|
|
|
|
|
|
|
} |
1011
|
286
|
|
|
|
|
269
|
$pow /= 2; |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
### final depth: $depth - $depth_adjust |
1015
|
|
|
|
|
|
|
### $n |
1016
|
|
|
|
|
|
|
### depth_to_n: $self->tree_depth_to_n($depth - $depth_adjust) |
1017
|
|
|
|
|
|
|
### add_offset: join(',',@add_offset) |
1018
|
|
|
|
|
|
|
### add_mult: join(',',@add_mult) |
1019
|
|
|
|
|
|
|
|
1020
|
240
|
|
|
|
|
416
|
$n += $self->tree_depth_to_n($depth - $depth_adjust); |
1021
|
|
|
|
|
|
|
|
1022
|
240
|
100
|
|
|
|
343
|
if (@add_offset) { |
1023
|
210
|
|
|
|
|
194
|
foreach my $add_offset (@add_offset) { |
1024
|
551
|
|
|
|
|
439
|
$add_offset = $depth - $add_offset; # mutate array |
1025
|
|
|
|
|
|
|
### add: "unadj depth=$add_offset", _depth_to_octant_added([$add_offset],[1], $zero)." x add_mult" |
1026
|
|
|
|
|
|
|
# .$add_mult[$i] |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
### total add: _depth_to_octant_added ([@add_offset], [@add_mult], $zero) |
1029
|
210
|
|
|
|
|
352
|
$n += _depth_to_octant_added (\@add_offset, \@add_mult, $zero); |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
### xy_to_n() return n: $n |
1033
|
240
|
|
|
|
|
408
|
return $n; |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# Shared with ToothpickReplicate. |
1038
|
|
|
|
|
|
|
# not exact |
1039
|
|
|
|
|
|
|
sub rect_to_n_range { |
1040
|
108
|
|
|
108
|
1
|
9217
|
my ($self, $x1,$y1, $x2,$y2) = @_; |
1041
|
|
|
|
|
|
|
### ToothpickTree rect_to_n_range(): "$x1,$y1 $x2,$y2" |
1042
|
|
|
|
|
|
|
|
1043
|
108
|
|
|
|
|
270
|
$x1 = round_nearest ($x1); |
1044
|
108
|
|
|
|
|
644
|
$y1 = round_nearest ($y1); |
1045
|
108
|
|
|
|
|
539
|
$x2 = round_nearest ($x2); |
1046
|
108
|
|
|
|
|
558
|
$y2 = round_nearest ($y2); |
1047
|
|
|
|
|
|
|
|
1048
|
108
|
100
|
|
|
|
576
|
($x1,$x2) = ($x2,$x1) if $x1 > $x2; |
1049
|
108
|
100
|
|
|
|
185
|
($y1,$y2) = ($y2,$y1) if $y1 > $y2; |
1050
|
|
|
|
|
|
|
|
1051
|
108
|
|
|
|
|
155
|
my $parts = $self->{'parts'}; |
1052
|
108
|
50
|
33
|
|
|
454
|
if ($parts eq 'wedge' || $parts eq 'wedge+1') { |
1053
|
0
|
|
|
|
|
0
|
my ($len,$level) = round_down_pow ($y2, 2); |
1054
|
0
|
|
|
|
|
0
|
return (0, (8*$len*$len-5)/3 + 2*$len); |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
|
1057
|
108
|
100
|
66
|
|
|
371
|
if ($parts eq '4' || $parts eq 'two_horiz') { |
1058
|
22
|
50
|
|
|
|
41
|
if ($parts eq 'two_horiz') { |
1059
|
0
|
|
|
|
|
0
|
$x2 += 3; |
1060
|
0
|
|
|
|
|
0
|
$x1 -= 3; |
1061
|
0
|
|
|
|
|
0
|
$y2 += 2; |
1062
|
0
|
|
|
|
|
0
|
$y1 -= 2; |
1063
|
|
|
|
|
|
|
} |
1064
|
22
|
|
|
|
|
71
|
my ($len,$level) = round_down_pow (max(-$x1, |
1065
|
|
|
|
|
|
|
$x2, |
1066
|
|
|
|
|
|
|
-1-$y1, |
1067
|
|
|
|
|
|
|
$y2-1), |
1068
|
|
|
|
|
|
|
2); |
1069
|
22
|
|
|
|
|
373
|
return (0, (32*$len*$len-2)/3); |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
86
|
100
|
|
|
|
288
|
if ($parts eq '3') { |
1073
|
16
|
50
|
66
|
|
|
40
|
if ($x2 < 0 && $y2 < 0) { |
1074
|
|
|
|
|
|
|
### third quadrant only, no points ... |
1075
|
0
|
|
|
|
|
0
|
return (1,0); |
1076
|
|
|
|
|
|
|
} |
1077
|
|
|
|
|
|
|
# +---------+-------------+ |
1078
|
|
|
|
|
|
|
# | x1,y2-1 | x2,y2-1 | |
1079
|
|
|
|
|
|
|
# +---------+-------------+ |
1080
|
|
|
|
|
|
|
# | rot and X-1 | |
1081
|
|
|
|
|
|
|
# | x2-1+1,y1 | |
1082
|
|
|
|
|
|
|
# +-------------+ |
1083
|
|
|
|
|
|
|
# Point N=28 X=3,Y=-4 and further X=2^k-1,Y=-2^k belong in previous |
1084
|
|
|
|
|
|
|
# $level level, but don't worry about that for now. |
1085
|
16
|
|
|
|
|
52
|
my ($len,$level) = round_down_pow (max(-$x1, |
1086
|
|
|
|
|
|
|
$x2, |
1087
|
|
|
|
|
|
|
-$y1, |
1088
|
|
|
|
|
|
|
$y2-1), |
1089
|
|
|
|
|
|
|
2); |
1090
|
16
|
|
|
|
|
269
|
return (0, 8*$len*$len); |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
} |
1093
|
70
|
50
|
|
|
|
113
|
if ($parts eq '2') { |
1094
|
0
|
0
|
|
|
|
0
|
if ($y2 < 0) { |
1095
|
0
|
|
|
|
|
0
|
return (1,0); |
1096
|
|
|
|
|
|
|
} |
1097
|
0
|
|
|
|
|
0
|
my ($len,$level) = round_down_pow (max(-$x1, |
1098
|
|
|
|
|
|
|
$x2, |
1099
|
|
|
|
|
|
|
$y2-1), |
1100
|
|
|
|
|
|
|
2); |
1101
|
0
|
|
|
|
|
0
|
return (0, (16*$len*$len-4)/3); |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
} |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
### assert: $parts eq '1' |
1106
|
70
|
50
|
33
|
|
|
260
|
if ($x2 < 1 || $y2 < 1) { |
1107
|
0
|
|
|
|
|
0
|
return (1,0); |
1108
|
|
|
|
|
|
|
} |
1109
|
70
|
|
|
|
|
202
|
my ($len,$level) = round_down_pow (max($x2, $y2-1), |
1110
|
|
|
|
|
|
|
2); |
1111
|
70
|
|
|
|
|
1404
|
return (0, (8*$len*$len-5)/3); |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
# Is it possible to calculate this by the bits of N rather than by X,Y? |
1117
|
|
|
|
|
|
|
sub tree_n_children { |
1118
|
0
|
|
|
0
|
1
|
0
|
my ($self, $n) = @_; |
1119
|
|
|
|
|
|
|
### tree_n_children(): $n |
1120
|
|
|
|
|
|
|
|
1121
|
0
|
0
|
|
|
|
0
|
my ($x,$y) = $self->n_to_xy($n) |
1122
|
|
|
|
|
|
|
or return; # before n_start(), no children |
1123
|
|
|
|
|
|
|
|
1124
|
0
|
|
|
|
|
0
|
my ($n1,$n2); |
1125
|
0
|
0
|
|
|
|
0
|
if (($x + $y) % 2) { |
1126
|
|
|
|
|
|
|
# odd, horizontal to children |
1127
|
0
|
|
|
|
|
0
|
$n1 = $self->xy_to_n($x-1,$y); |
1128
|
0
|
|
|
|
|
0
|
$n2 = $self->xy_to_n($x+1,$y); |
1129
|
|
|
|
|
|
|
} else { |
1130
|
|
|
|
|
|
|
# even, vertical to children |
1131
|
0
|
|
|
|
|
0
|
$n1 = $self->xy_to_n($x,$y-1); |
1132
|
0
|
|
|
|
|
0
|
$n2 = $self->xy_to_n($x,$y+1); |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
### $n1 |
1135
|
|
|
|
|
|
|
### $n2 |
1136
|
0
|
0
|
0
|
|
|
0
|
if (($n1||0) > ($n2||0)) { |
|
|
|
0
|
|
|
|
|
1137
|
0
|
|
|
|
|
0
|
($n1,$n2) = ($n2,$n1); # sorted |
1138
|
|
|
|
|
|
|
} |
1139
|
0
|
0
|
0
|
|
|
0
|
return ((defined $n1 && $n1 > $n ? $n1 : ()), |
|
|
0
|
0
|
|
|
|
|
1140
|
|
|
|
|
|
|
(defined $n2 && $n2 > $n ? $n2 : ())); |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
my %parts_to_numroots = (two_horiz => 2, |
1144
|
|
|
|
|
|
|
# everything else 1 root |
1145
|
|
|
|
|
|
|
); |
1146
|
|
|
|
|
|
|
sub tree_num_roots { |
1147
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
1148
|
0
|
|
0
|
|
|
0
|
return ($parts_to_numroots{$self->{'parts'}} || 1); |
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
sub tree_n_parent { |
1152
|
0
|
|
|
0
|
1
|
0
|
my ($self, $n) = @_; |
1153
|
|
|
|
|
|
|
### tree_n_parent(): $n |
1154
|
|
|
|
|
|
|
|
1155
|
0
|
|
|
|
|
0
|
$n = int($n); |
1156
|
0
|
0
|
0
|
|
|
0
|
if ($n < ($parts_to_numroots{$self->{'parts'}} || 1)) { |
1157
|
0
|
|
|
|
|
0
|
return undef; |
1158
|
|
|
|
|
|
|
} |
1159
|
0
|
0
|
|
|
|
0
|
my ($x,$y) = $self->n_to_xy($n) |
1160
|
|
|
|
|
|
|
or return undef; |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
### parent at: "xy=$x,$y" |
1163
|
|
|
|
|
|
|
### parent odd list: (($x%2) ^ ($y%2)) && ($self->xy_to_n_list($x,$y-1), $self->xy_to_n_list($x,$y+1)) |
1164
|
|
|
|
|
|
|
### parent even list: !(($x%2) ^ ($y%2)) && ($self->xy_to_n_list($x-1,$y), $self->xy_to_n_list($x+1,$y)) |
1165
|
|
|
|
|
|
|
### parent min: min($self->xy_to_n_list($x-1,$y), $self->xy_to_n_list($x+1,$y),$self->xy_to_n_list($x,$y-1), $self->xy_to_n_list($x,$y+1)) |
1166
|
|
|
|
|
|
|
|
1167
|
0
|
0
|
|
|
|
0
|
return min((($x%2) ^ ($y%2)) |
1168
|
|
|
|
|
|
|
? |
1169
|
|
|
|
|
|
|
# odd X,Y, vertical to parent |
1170
|
|
|
|
|
|
|
($self->xy_to_n_list($x,$y-1), |
1171
|
|
|
|
|
|
|
$self->xy_to_n_list($x,$y+1)) |
1172
|
|
|
|
|
|
|
: |
1173
|
|
|
|
|
|
|
# even X,Y, horizontal to parent |
1174
|
|
|
|
|
|
|
($self->xy_to_n_list($x-1,$y), |
1175
|
|
|
|
|
|
|
$self->xy_to_n_list($x+1,$y))); |
1176
|
|
|
|
|
|
|
} |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
sub tree_n_to_depth { |
1179
|
882
|
|
|
882
|
1
|
3254
|
my ($self, $n) = @_; |
1180
|
|
|
|
|
|
|
### tree_n_to_depth(): "$n" |
1181
|
|
|
|
|
|
|
|
1182
|
882
|
50
|
|
|
|
1374
|
if ($n < 0) { |
1183
|
0
|
|
|
|
|
0
|
return undef; |
1184
|
|
|
|
|
|
|
} |
1185
|
882
|
|
|
|
|
1233
|
my ($depth) = _n0_to_depth_and_rem($self, int($n)); |
1186
|
|
|
|
|
|
|
### n0 depth: $depth |
1187
|
882
|
|
|
|
|
1435
|
return $depth; |
1188
|
|
|
|
|
|
|
} |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
# Do a binary search for the bits of depth which give Ndepth <= N. |
1192
|
|
|
|
|
|
|
# |
1193
|
|
|
|
|
|
|
# Ndepth grows as roughly depth*depth, so this is about log4(N) many |
1194
|
|
|
|
|
|
|
# compares. For large N wouldn't want to a table to search through to |
1195
|
|
|
|
|
|
|
# sqrt(N). |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
sub _n0_to_depth_and_rem { |
1198
|
1169
|
|
|
1169
|
|
897
|
my ($self, $n) = @_; |
1199
|
|
|
|
|
|
|
### _n0_to_depth_and_rem(): "n=$n parts=$self->{'parts'}" |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
# For parts=4 have depth=2^exp formula |
1202
|
|
|
|
|
|
|
# T[2^exp] = parts*(4^exp-1)*2/3 + 3 |
1203
|
|
|
|
|
|
|
# parts*(4^exp-1)*2/3 + 3 = N |
1204
|
|
|
|
|
|
|
# 4^exp = (N-3)*3/2parts, round down |
1205
|
|
|
|
|
|
|
# but must be bigger ... (WHY-IS-IT-SO?) |
1206
|
|
|
|
|
|
|
# |
1207
|
1169
|
|
|
|
|
2370
|
my ($pow,$exp) = round_down_pow (12*$n, # /$self->{'parts'} |
1208
|
|
|
|
|
|
|
4); |
1209
|
1169
|
50
|
|
|
|
8716
|
if (is_infinite($exp)) { |
1210
|
0
|
|
|
|
|
0
|
return ($exp,0); |
1211
|
|
|
|
|
|
|
} |
1212
|
|
|
|
|
|
|
### $pow |
1213
|
|
|
|
|
|
|
### $exp |
1214
|
|
|
|
|
|
|
|
1215
|
1169
|
|
|
|
|
5123
|
my $depth = 0; |
1216
|
1169
|
|
|
|
|
895
|
my $n_depth = 0; |
1217
|
1169
|
|
|
|
|
822
|
$pow = 2 ** $exp; # pow=2^exp down to 1, inclusive |
1218
|
|
|
|
|
|
|
|
1219
|
1169
|
|
|
|
|
1577
|
while ($exp-- >= 0) { |
1220
|
6021
|
|
|
|
|
5108
|
my $try_depth = $depth + $pow; |
1221
|
6021
|
|
|
|
|
7919
|
my $try_n_depth = $self->tree_depth_to_n($try_depth); |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
### $depth |
1224
|
|
|
|
|
|
|
### $pow |
1225
|
|
|
|
|
|
|
### $try_depth |
1226
|
|
|
|
|
|
|
### $try_n_depth |
1227
|
|
|
|
|
|
|
|
1228
|
6021
|
100
|
|
|
|
7812
|
if ($try_n_depth <= $n) { |
1229
|
|
|
|
|
|
|
### use this tried depth ... |
1230
|
2808
|
|
|
|
|
1965
|
$depth = $try_depth; |
1231
|
2808
|
|
|
|
|
2108
|
$n_depth = $try_n_depth; |
1232
|
|
|
|
|
|
|
} |
1233
|
6021
|
|
|
|
|
9461
|
$pow /= 2; |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
### _n0_to_depth_and_rem() final ... |
1237
|
|
|
|
|
|
|
### $depth |
1238
|
|
|
|
|
|
|
### remainder: $n - $n_depth |
1239
|
|
|
|
|
|
|
|
1240
|
1169
|
|
|
|
|
1602
|
return ($depth, $n - $n_depth); |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
# First unsorted @pending |
1244
|
|
|
|
|
|
|
# depth=119 parts=4 pow=64 119 |
1245
|
|
|
|
|
|
|
# depth=119 parts=4 pow=32 56,55 |
1246
|
|
|
|
|
|
|
# depth=119 parts=4 pow=16 25,24,23 |
1247
|
|
|
|
|
|
|
# depth=119 parts=4 pow=8 10,9,8,7 <- list crosses pow=8 boundary |
1248
|
|
|
|
|
|
|
# depth=119 parts=4 pow=4 3,2,7 |
1249
|
|
|
|
|
|
|
# depth=119 parts=4 pow=2 3 |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
# T(2^k+rem) = T(2^k) + T(rem) + 2T(rem-1) rem>=1 |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1255
|
|
|
|
|
|
|
# tree_depth_to_n() |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
# initial toothpicks not counted by the blocks crunching |
1258
|
|
|
|
|
|
|
my %depth_to_n_initial |
1259
|
|
|
|
|
|
|
= (4 => 3, # 1 origin + 1 above + 1 below |
1260
|
|
|
|
|
|
|
3 => 2, # 1 origin + 1 above |
1261
|
|
|
|
|
|
|
2 => 1, # 1 middle X=0,Y=1 |
1262
|
|
|
|
|
|
|
1 => 0, |
1263
|
|
|
|
|
|
|
octant => 0, |
1264
|
|
|
|
|
|
|
octant_up => 0, |
1265
|
|
|
|
|
|
|
wedge => 4, |
1266
|
|
|
|
|
|
|
'wedge+1' => 3, |
1267
|
|
|
|
|
|
|
two_horiz => 0, |
1268
|
|
|
|
|
|
|
); |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
my %tree_depth_to_n = (4 => [ 0, 1, 3 ], |
1271
|
|
|
|
|
|
|
3 => [ 0, 1, 3 ], |
1272
|
|
|
|
|
|
|
2 => [ 0, 1 ], |
1273
|
|
|
|
|
|
|
1 => [ 0, 1 ], |
1274
|
|
|
|
|
|
|
octant => [ 0, 1 ], |
1275
|
|
|
|
|
|
|
octant_up => [ 0, 1 ], |
1276
|
|
|
|
|
|
|
wedge => [ 0, 1, 2 ], |
1277
|
|
|
|
|
|
|
'wedge+1' => [ 0, 1 ], |
1278
|
|
|
|
|
|
|
two_horiz => [ 0, 2, 4 ], |
1279
|
|
|
|
|
|
|
); |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
sub tree_depth_to_n { |
1282
|
7491
|
|
|
7491
|
1
|
23067
|
my ($self, $depth) = @_; |
1283
|
|
|
|
|
|
|
### tree_depth_to_n(): "$depth parts=$self->{'parts'}" |
1284
|
|
|
|
|
|
|
|
1285
|
7491
|
50
|
|
|
|
9978
|
if ($depth < 0) { |
1286
|
0
|
|
|
|
|
0
|
return undef; |
1287
|
|
|
|
|
|
|
} |
1288
|
7491
|
|
|
|
|
5221
|
$depth = int($depth); |
1289
|
|
|
|
|
|
|
|
1290
|
7491
|
|
|
|
|
7640
|
my $parts = $self->{'parts'}; |
1291
|
|
|
|
|
|
|
{ |
1292
|
7491
|
|
|
|
|
5088
|
my $initial = $tree_depth_to_n{$parts}; |
|
7491
|
|
|
|
|
7267
|
|
1293
|
7491
|
100
|
|
|
|
12029
|
if ($depth <= $#$initial) { |
1294
|
123
|
|
|
|
|
234
|
return $initial->[$depth]; |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
# Adjust $depth so it's parts=4 style counting from the origin X=0,Y=0 as |
1299
|
|
|
|
|
|
|
# depth=0. So for example parts=1 is adjusted $depth+=2 since its depth=0 |
1300
|
|
|
|
|
|
|
# is at X=1,Y=1 which is 2 levels down. |
1301
|
|
|
|
|
|
|
# |
1302
|
|
|
|
|
|
|
# The parts=4 style means that depth=2^k is the "A" point of a new |
1303
|
|
|
|
|
|
|
# replication. |
1304
|
|
|
|
|
|
|
# |
1305
|
7368
|
|
|
|
|
6700
|
$depth += $parts_depth_adjust{$parts}; |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
# +1 for parts=3 using depth+1 |
1308
|
7368
|
|
|
|
|
14080
|
my ($pow,$exp) = round_down_pow ($depth+1, 2); |
1309
|
7368
|
50
|
|
|
|
55685
|
if (is_infinite($exp)) { |
1310
|
0
|
|
|
|
|
0
|
return $exp; |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
### $pow |
1313
|
|
|
|
|
|
|
### $exp |
1314
|
|
|
|
|
|
|
|
1315
|
7368
|
|
|
|
|
31531
|
my $zero = $depth*0; |
1316
|
7368
|
|
|
|
|
7395
|
my $n = $depth_to_n_initial{$parts} + $zero; |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
# @pending is a list of depth values. |
1319
|
|
|
|
|
|
|
# @mult is the multiple of T[depth] desired for that @pending entry. |
1320
|
|
|
|
|
|
|
# |
1321
|
|
|
|
|
|
|
# @pending has its values mostly in order high to low and growing by one |
1322
|
|
|
|
|
|
|
# more value at each $exp level, but sometimes it grows a bit more and |
1323
|
|
|
|
|
|
|
# sometimes values are not entirely high to low and may even be |
1324
|
|
|
|
|
|
|
# duplicated. |
1325
|
|
|
|
|
|
|
# |
1326
|
7368
|
|
|
|
|
5316
|
my @pending; |
1327
|
|
|
|
|
|
|
my @mult; |
1328
|
|
|
|
|
|
|
|
1329
|
7368
|
100
|
100
|
|
|
30385
|
if ($parts eq 'octant' || $parts eq 'octant_up') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1330
|
883
|
|
|
|
|
1229
|
@pending = ($depth); |
1331
|
883
|
|
|
|
|
1145
|
@mult = (1+$zero); |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge') { |
1334
|
|
|
|
|
|
|
# wedge(depth) = 2*oct(depth-1) + 4 |
1335
|
66
|
|
|
|
|
63
|
@pending = ($depth); |
1336
|
66
|
|
|
|
|
60
|
@mult = (2+$zero); |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge+1') { |
1339
|
|
|
|
|
|
|
# wedge(depth) = 2*oct(depth-1) + depth - depth&1 |
1340
|
0
|
|
|
|
|
0
|
$n += $depth - ($depth%2); |
1341
|
0
|
|
|
|
|
0
|
@pending = ($depth-1); |
1342
|
0
|
|
|
|
|
0
|
@mult = (2+$zero); |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
} elsif ($parts eq 'two_horiz') { |
1345
|
40
|
|
|
|
|
35
|
$n -= 4*$depth - 16; # overlapping spines |
1346
|
40
|
|
|
|
|
44
|
@pending = ($depth,$depth-3); |
1347
|
40
|
|
|
|
|
48
|
@mult = ((4+$zero) x 2); |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
} elsif ($parts eq '3') { |
1350
|
1557
|
|
|
|
|
2288
|
@pending = ($depth+1, $depth, $depth-1); |
1351
|
1557
|
|
|
|
|
1824
|
@mult = (1+$zero, 3+$zero, 2+$zero); |
1352
|
1557
|
|
|
|
|
1268
|
$n -= 3*$depth - 8; |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
} else { |
1355
|
|
|
|
|
|
|
# quadrant(depth) = oct(depth) + oct(depth-1) - (d-3) |
1356
|
|
|
|
|
|
|
# half(depth) = 2*quadrant(depth) + 1 |
1357
|
|
|
|
|
|
|
# full(depth) = 4*quadrant(depth) + 3 |
1358
|
4822
|
|
|
|
|
6476
|
@pending = ($depth, $depth-1); |
1359
|
4822
|
|
|
|
|
5942
|
@mult = ($parts + $zero) x 2; |
1360
|
4822
|
|
|
|
|
4508
|
$n -= $parts*($depth-3); |
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
|
1363
|
7368
|
|
|
|
|
10076
|
while (--$exp >= 0) { |
1364
|
25649
|
100
|
|
|
|
34513
|
last unless @pending; |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
### @pending |
1367
|
|
|
|
|
|
|
### @mult |
1368
|
|
|
|
|
|
|
### $exp |
1369
|
|
|
|
|
|
|
### $pow |
1370
|
|
|
|
|
|
|
|
1371
|
22423
|
|
|
|
|
15530
|
my @new_pending; |
1372
|
|
|
|
|
|
|
my @new_mult; |
1373
|
0
|
|
|
|
|
0
|
my $tpow; |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
# if (1||join(',',@pending) ne join(',',reverse sort {$a<=>$b} @pending)) { |
1376
|
|
|
|
|
|
|
# # print "depth=$depth parts=$parts pow=$pow ",join(',',@pending),"\n"; |
1377
|
|
|
|
|
|
|
# print "mult ",join(',',@mult),"\n"; |
1378
|
|
|
|
|
|
|
# } |
1379
|
|
|
|
|
|
|
|
1380
|
22423
|
|
|
|
|
19689
|
foreach my $depth (@pending) { |
1381
|
46603
|
|
|
|
|
35067
|
my $mult = shift @mult; |
1382
|
|
|
|
|
|
|
### assert: $depth >= 2 |
1383
|
|
|
|
|
|
|
### assert: $depth < 2*$pow |
1384
|
|
|
|
|
|
|
|
1385
|
46603
|
100
|
|
|
|
57231
|
if ($depth <= 3) { |
1386
|
11148
|
100
|
|
|
|
15123
|
if ($depth eq '3') { |
1387
|
|
|
|
|
|
|
### depth==3 total=1 ... |
1388
|
6927
|
|
|
|
|
5299
|
$n += $mult; |
1389
|
|
|
|
|
|
|
} else { |
1390
|
|
|
|
|
|
|
### depth==2 total=0 ... |
1391
|
|
|
|
|
|
|
} |
1392
|
11148
|
|
|
|
|
11892
|
next; |
1393
|
|
|
|
|
|
|
} |
1394
|
|
|
|
|
|
|
|
1395
|
35455
|
100
|
|
|
|
44117
|
if ($depth < $pow) { |
1396
|
|
|
|
|
|
|
# Smaller than $pow, keep unchanged. Cannot stop processing |
1397
|
|
|
|
|
|
|
# @pending on finding one $depth<$pow because @pending is not quite |
1398
|
|
|
|
|
|
|
# sorted and therefore might have a later $depth>=$pow. |
1399
|
6689
|
|
|
|
|
5521
|
push @new_pending, $depth; |
1400
|
6689
|
|
|
|
|
4990
|
push @new_mult, $mult; |
1401
|
6689
|
|
|
|
|
8346
|
next; |
1402
|
|
|
|
|
|
|
} |
1403
|
28766
|
|
|
|
|
20385
|
my $rem = $depth - $pow; |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
### $depth |
1406
|
|
|
|
|
|
|
### $mult |
1407
|
|
|
|
|
|
|
### $rem |
1408
|
|
|
|
|
|
|
### assert: $rem >= 0 && $rem < $pow |
1409
|
|
|
|
|
|
|
|
1410
|
28766
|
|
|
|
|
18623
|
my $basemult = $mult; # multiple of oct(2^k) base part |
1411
|
|
|
|
|
|
|
|
1412
|
28766
|
100
|
|
|
|
37408
|
if ($rem == 0) { |
|
|
100
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
### rem==0, so just the oct(2^k) part ... |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
} elsif ($rem == 1) { |
1416
|
|
|
|
|
|
|
### rem==1 "A" ... |
1417
|
5263
|
|
|
|
|
4226
|
$n += $mult; |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
} else { |
1420
|
|
|
|
|
|
|
### rem >= 2, formula ... |
1421
|
|
|
|
|
|
|
# formula oct(pow+rem) = oct(pow) + oct(rem+1) + 2*oct(rem) - rem + 4 |
1422
|
18234
|
|
|
|
|
15185
|
$n += (4-$rem)*$mult; |
1423
|
|
|
|
|
|
|
|
1424
|
18234
|
|
|
|
|
12041
|
$rem += 1; # to give rem+1 |
1425
|
18234
|
100
|
100
|
|
|
39278
|
if ($rem == $pow) { |
|
|
100
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
### rem+1==pow so oct(2^k) by increasing basemult ... |
1427
|
4927
|
|
|
|
|
3782
|
$basemult += $mult; |
1428
|
|
|
|
|
|
|
} elsif (@new_pending && $new_pending[-1] == $rem) { |
1429
|
|
|
|
|
|
|
### combine rem+1 here with rem of previous ... |
1430
|
6971
|
|
|
|
|
5707
|
$new_mult[-1] += $mult; |
1431
|
|
|
|
|
|
|
} else { |
1432
|
6336
|
|
|
|
|
5806
|
push @new_pending, $rem; |
1433
|
6336
|
|
|
|
|
5394
|
push @new_mult, $mult; |
1434
|
|
|
|
|
|
|
} |
1435
|
18234
|
50
|
|
|
|
24761
|
if ($rem -= 1) { # to give plain rem again |
1436
|
18234
|
|
|
|
|
14775
|
push @new_pending, $rem; |
1437
|
18234
|
|
|
|
|
16048
|
push @new_mult, 2*$mult; |
1438
|
|
|
|
|
|
|
} |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
# oct(2^k) = (4^(k-1) - 4)/3 + 2^(k-1) |
1442
|
28766
|
|
66
|
|
|
56256
|
$tpow ||= ($pow*$pow - 16)/12 + $pow/2; |
1443
|
28766
|
|
|
|
|
37400
|
$n += $basemult * $tpow; |
1444
|
|
|
|
|
|
|
} |
1445
|
22423
|
|
|
|
|
29143
|
@pending = @new_pending; |
1446
|
22423
|
|
|
|
|
20462
|
@mult = @new_mult; |
1447
|
22423
|
|
|
|
|
37294
|
$pow /= 2; |
1448
|
|
|
|
|
|
|
} |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
### return: $n |
1451
|
7368
|
|
|
|
|
10841
|
return $n; |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1456
|
|
|
|
|
|
|
# $depth numbered from origin in parts=4 style. |
1457
|
|
|
|
|
|
|
# Return cells added at that depth, |
1458
|
|
|
|
|
|
|
# ie. added = depth_to_n($depth+1) - depth_to_n($depth) |
1459
|
|
|
|
|
|
|
# |
1460
|
|
|
|
|
|
|
# @$depth_list is a list of $depth values. |
1461
|
|
|
|
|
|
|
# @mult_list is the multiple of T[depth] desired for that @$depth_list entry. |
1462
|
|
|
|
|
|
|
# $depth_list->[0], ie. the first array entry, must be the biggest $depth. |
1463
|
|
|
|
|
|
|
# |
1464
|
|
|
|
|
|
|
# @$depth_list is maintained mostly high to low and growing by one more |
1465
|
|
|
|
|
|
|
# value at each $exp level, but sometimes it's a bit more and some values |
1466
|
|
|
|
|
|
|
# not high to low and possibly duplicated. |
1467
|
|
|
|
|
|
|
# |
1468
|
|
|
|
|
|
|
# added(pow) = 1 |
1469
|
|
|
|
|
|
|
# added(pow+1) = 2 |
1470
|
|
|
|
|
|
|
# added(pow+rem) = 2*added(rem) + added(rem+1) - 1 |
1471
|
|
|
|
|
|
|
# |
1472
|
|
|
|
|
|
|
# added(pow+pow-1) = 2*added(pow-1) + added(pow) - 1 |
1473
|
|
|
|
|
|
|
# = 2*added(pow-1) + 1 - 1 |
1474
|
|
|
|
|
|
|
# = 2*added(pow-1) |
1475
|
|
|
|
|
|
|
# repeats down to added(2^k-1) = 2^(k-1) |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
sub _depth_to_octant_added { |
1478
|
1268
|
|
|
1268
|
|
2241
|
my ($depth_list, $mult_list, $zero) = @_; |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
### _depth_to_octant_added(): join(',',@$depth_list) |
1481
|
|
|
|
|
|
|
### assert: scalar(@$depth_list) >= 1 |
1482
|
|
|
|
|
|
|
### assert: max(@$depth_list) == $depth_list->[0] |
1483
|
|
|
|
|
|
|
|
1484
|
1268
|
|
|
|
|
2488
|
my ($pow,$exp) = round_down_pow ($depth_list->[0], 2); |
1485
|
1268
|
50
|
|
|
|
9518
|
if (is_infinite($exp)) { |
1486
|
0
|
|
|
|
|
0
|
return $exp; |
1487
|
|
|
|
|
|
|
} |
1488
|
|
|
|
|
|
|
### $pow |
1489
|
|
|
|
|
|
|
### $exp |
1490
|
|
|
|
|
|
|
|
1491
|
1268
|
|
|
|
|
5254
|
my $add = $zero; |
1492
|
|
|
|
|
|
|
|
1493
|
1268
|
|
|
|
|
1844
|
while (--$exp >= 0) { # running $pow down to 2 (inclusive) |
1494
|
|
|
|
|
|
|
### assert: $pow >= 2 |
1495
|
3695
|
100
|
|
|
|
4897
|
last unless @$depth_list; |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
### pending: join(',',@$depth_list) |
1498
|
|
|
|
|
|
|
### mult : join(',',@$mult_list) |
1499
|
|
|
|
|
|
|
### $exp |
1500
|
|
|
|
|
|
|
### $pow |
1501
|
|
|
|
|
|
|
|
1502
|
3227
|
|
|
|
|
2265
|
my @new_depth_list; |
1503
|
|
|
|
|
|
|
my @new_mult_list; |
1504
|
|
|
|
|
|
|
|
1505
|
3227
|
|
|
|
|
3200
|
foreach my $depth (@$depth_list) { |
1506
|
6463
|
|
|
|
|
5404
|
my $mult = shift @$mult_list; |
1507
|
|
|
|
|
|
|
### assert: $depth >= 0 |
1508
|
|
|
|
|
|
|
### assert: $depth == int($depth) |
1509
|
|
|
|
|
|
|
|
1510
|
6463
|
100
|
|
|
|
8466
|
if ($depth <= 3) { |
1511
|
|
|
|
|
|
|
### depth==2or3 add=1 ... |
1512
|
2334
|
|
|
|
|
1677
|
$add += $mult; |
1513
|
2334
|
|
|
|
|
2575
|
next; |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
|
1516
|
4129
|
100
|
|
|
|
5308
|
if ($depth < $pow) { |
1517
|
|
|
|
|
|
|
# less than 2^exp so unchanged |
1518
|
1077
|
|
|
|
|
1077
|
push @new_depth_list, $depth; |
1519
|
1077
|
|
|
|
|
895
|
push @new_mult_list, $mult; |
1520
|
1077
|
|
|
|
|
1560
|
next; |
1521
|
|
|
|
|
|
|
} |
1522
|
|
|
|
|
|
|
|
1523
|
3052
|
|
|
|
|
2528
|
my $rem = $depth - $pow; |
1524
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
### $depth |
1526
|
|
|
|
|
|
|
### $mult |
1527
|
|
|
|
|
|
|
### $rem |
1528
|
|
|
|
|
|
|
### assert: $rem >= 0 && $rem <= $pow |
1529
|
|
|
|
|
|
|
|
1530
|
3052
|
100
|
100
|
|
|
8440
|
if ($rem == 0 || $rem == $pow-1) { |
1531
|
|
|
|
|
|
|
### rem==0, A of each, add=1 ... |
1532
|
|
|
|
|
|
|
### or depth=2*pow-1, add=1 ... |
1533
|
802
|
|
|
|
|
1226
|
$add += $mult; |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
} else { |
1536
|
|
|
|
|
|
|
### rem >= 2, formula ... |
1537
|
|
|
|
|
|
|
# A(pow+rem) = A(rem+1) + 2A(rem) - 1 |
1538
|
2250
|
|
|
|
|
1737
|
$add -= $mult; |
1539
|
|
|
|
|
|
|
|
1540
|
2250
|
|
|
|
|
1702
|
$rem += 1; # to make rem+1 |
1541
|
2250
|
100
|
100
|
|
|
5155
|
if (@new_depth_list && $new_depth_list[-1] == $rem) { |
1542
|
|
|
|
|
|
|
# add to previously pushed pending depth |
1543
|
|
|
|
|
|
|
# print "rem=$rem ",join(',',@new_depth_list),"\n"; |
1544
|
723
|
|
|
|
|
728
|
$new_mult_list[-1] += $mult; |
1545
|
|
|
|
|
|
|
} else { |
1546
|
1527
|
|
|
|
|
1857
|
push @new_depth_list, $rem; |
1547
|
1527
|
|
|
|
|
1600
|
push @new_mult_list, $mult; |
1548
|
|
|
|
|
|
|
} |
1549
|
2250
|
|
|
|
|
2098
|
push @new_depth_list, $rem-1; # back to plain rem |
1550
|
2250
|
|
|
|
|
3925
|
push @new_mult_list, 2*$mult; |
1551
|
|
|
|
|
|
|
} |
1552
|
|
|
|
|
|
|
} |
1553
|
3227
|
|
|
|
|
3796
|
$depth_list = \@new_depth_list; |
1554
|
3227
|
|
|
|
|
3168
|
$mult_list = \@new_mult_list; |
1555
|
3227
|
|
|
|
|
6332
|
$pow /= 2; |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
### return: $add |
1559
|
1268
|
|
|
|
|
1857
|
return $add; |
1560
|
|
|
|
|
|
|
} |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
sub tree_n_to_subheight { |
1565
|
0
|
|
|
0
|
1
|
0
|
my ($self, $n) = @_; |
1566
|
|
|
|
|
|
|
### tree_n_to_subheight(): $n |
1567
|
|
|
|
|
|
|
|
1568
|
0
|
0
|
|
|
|
0
|
if ($n < 0) { return undef; } |
|
0
|
|
|
|
|
0
|
|
1569
|
0
|
0
|
|
|
|
0
|
if (is_infinite($n)) { return $n; } |
|
0
|
|
|
|
|
0
|
|
1570
|
|
|
|
|
|
|
|
1571
|
0
|
|
|
|
|
0
|
my $zero = $n * 0; |
1572
|
0
|
|
|
|
|
0
|
(my $depth, $n) = _n0_to_depth_and_rem($self, int($n)); |
1573
|
|
|
|
|
|
|
### $depth |
1574
|
|
|
|
|
|
|
### $n |
1575
|
|
|
|
|
|
|
|
1576
|
0
|
|
|
|
|
0
|
my $parts = $self->{'parts'}; |
1577
|
0
|
|
|
|
|
0
|
$depth += $parts_depth_adjust{$parts}; |
1578
|
|
|
|
|
|
|
### depth adjusted to: $depth |
1579
|
|
|
|
|
|
|
|
1580
|
0
|
0
|
0
|
|
|
0
|
if ($parts eq 'octant') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1581
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added ([$depth],[1], $zero); |
1582
|
0
|
|
|
|
|
0
|
$n = $add-1 - $n; |
1583
|
|
|
|
|
|
|
### octant mirror numbering to n: $n |
1584
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
} elsif ($parts eq 'octant_up') { |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge' || $parts eq 'wedge+1') { |
1588
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added ([$depth],[1], $zero); |
1589
|
|
|
|
|
|
|
### wedge half width: $add |
1590
|
0
|
0
|
|
|
|
0
|
if ($parts eq 'wedge+1') { |
1591
|
|
|
|
|
|
|
# 0, 1 to $add, $add+1 to 2*$add, 2*$add+1 |
1592
|
0
|
0
|
0
|
|
|
0
|
if ($n == 0 || $n == 2*$add+1) { |
1593
|
0
|
|
|
|
|
0
|
return 0; # first,last toothpicks don't grow |
1594
|
|
|
|
|
|
|
} |
1595
|
0
|
|
|
|
|
0
|
$n -= 1; |
1596
|
|
|
|
|
|
|
} |
1597
|
|
|
|
|
|
|
### assert: $n < 2*$add |
1598
|
0
|
0
|
|
|
|
0
|
if ($n >= $add) { |
1599
|
|
|
|
|
|
|
### wedge second half |
1600
|
0
|
|
|
|
|
0
|
$n = 2*$add-1 - $n; # mirror |
1601
|
|
|
|
|
|
|
} |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
} elsif ($parts eq 'two_horiz') { |
1604
|
|
|
|
|
|
|
### two_horiz ... |
1605
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added([$depth,$depth-3],[1,1], $zero) - 1; |
1606
|
|
|
|
|
|
|
### add quad: $add |
1607
|
|
|
|
|
|
|
### assert: $n < 4*$add |
1608
|
0
|
0
|
|
|
|
0
|
if ($n >= 2*$add) { |
1609
|
|
|
|
|
|
|
### two_horiz symmetric left,right halves ... |
1610
|
0
|
|
|
|
|
0
|
$n -= 2*$add; |
1611
|
|
|
|
|
|
|
### $n |
1612
|
|
|
|
|
|
|
} |
1613
|
0
|
0
|
|
|
|
0
|
if ($n >= $add) { |
1614
|
|
|
|
|
|
|
### two_horiz mirror top,bottom quarters ... |
1615
|
0
|
|
|
|
|
0
|
$n = 2*$add-1 - $n; |
1616
|
|
|
|
|
|
|
### $n |
1617
|
|
|
|
|
|
|
} |
1618
|
|
|
|
|
|
|
|
1619
|
0
|
|
|
|
|
0
|
$add = _depth_to_octant_added ([$depth],[1], $zero); |
1620
|
|
|
|
|
|
|
### add oct: $add |
1621
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
1622
|
|
|
|
|
|
|
### two_horiz first octant, mirror ... |
1623
|
0
|
|
|
|
|
0
|
$n = $add-1 - $n; |
1624
|
|
|
|
|
|
|
} else { |
1625
|
|
|
|
|
|
|
### two_horiz second octant, depth-3 ... |
1626
|
0
|
|
|
|
|
0
|
$n -= $add-1; |
1627
|
0
|
|
|
|
|
0
|
$depth -= 3; |
1628
|
|
|
|
|
|
|
} |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
} else { |
1631
|
|
|
|
|
|
|
### assert: $parts eq '1' || $parts eq '2' || $parts eq '3' || $parts eq '4' |
1632
|
0
|
0
|
|
|
|
0
|
if ($parts eq '3') { |
1633
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added ([$depth+1,$depth],[1,1], $zero) |
1634
|
|
|
|
|
|
|
- 1; # undouble spine |
1635
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
1636
|
0
|
|
|
|
|
0
|
$depth += 1; |
1637
|
|
|
|
|
|
|
} else { |
1638
|
0
|
|
|
|
|
0
|
$n -= $add; |
1639
|
0
|
|
|
|
|
0
|
$parts = '2'; |
1640
|
|
|
|
|
|
|
} |
1641
|
|
|
|
|
|
|
} |
1642
|
|
|
|
|
|
|
|
1643
|
0
|
0
|
0
|
|
|
0
|
if ($parts eq '2' || $parts eq '4') { |
1644
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added([$depth,$depth-1],[1,1], $zero) |
1645
|
|
|
|
|
|
|
- 1; # undouble spine |
1646
|
0
|
0
|
|
|
|
0
|
if ($n >= 2*$add) { |
1647
|
|
|
|
|
|
|
# parts=4 rotate lower ... |
1648
|
0
|
|
|
|
|
0
|
$n -= 2*$add; |
1649
|
|
|
|
|
|
|
} |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
### add quadrant: $add |
1652
|
|
|
|
|
|
|
### assert: $n < 2*$add |
1653
|
0
|
0
|
|
|
|
0
|
if ($n >= $add) { |
1654
|
|
|
|
|
|
|
### parts=2 left half mirror ... |
1655
|
0
|
|
|
|
|
0
|
$n = 2*$add-1 - $n; |
1656
|
|
|
|
|
|
|
### $n |
1657
|
|
|
|
|
|
|
} else { |
1658
|
|
|
|
|
|
|
### parts=2 right half unchanged ... |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
### quadrant ... |
1663
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added ([$depth],[1], $zero); |
1664
|
0
|
|
|
|
|
0
|
$n -= $add; |
1665
|
0
|
0
|
|
|
|
0
|
if ($n < 0) { |
1666
|
|
|
|
|
|
|
### lower octant ... |
1667
|
0
|
|
|
|
|
0
|
$n = -1-$n; # mirror |
1668
|
|
|
|
|
|
|
} else { |
1669
|
|
|
|
|
|
|
### upper octant ... |
1670
|
0
|
|
|
|
|
0
|
$depth -= 1; |
1671
|
0
|
|
|
|
|
0
|
$n += 1; # undouble spine |
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
} |
1674
|
|
|
|
|
|
|
|
1675
|
0
|
0
|
|
|
|
0
|
if ($depth <= 4) { |
1676
|
0
|
|
|
|
|
0
|
return undef; # initial points |
1677
|
|
|
|
|
|
|
} |
1678
|
|
|
|
|
|
|
|
1679
|
0
|
|
|
|
|
0
|
my $dbase; |
1680
|
0
|
|
|
|
|
0
|
my ($pow,$exp) = round_down_pow ($depth, 2); |
1681
|
|
|
|
|
|
|
|
1682
|
0
|
|
|
|
|
0
|
for ( ; $exp--; $pow /= 2) { |
1683
|
|
|
|
|
|
|
### at: "depth=$depth pow=$pow n=$n dbase=".($dbase||'inf') |
1684
|
|
|
|
|
|
|
### assert: $n >= 0 |
1685
|
|
|
|
|
|
|
|
1686
|
0
|
0
|
|
|
|
0
|
if ($n == 0) { |
1687
|
|
|
|
|
|
|
### n=0 on spine ... |
1688
|
0
|
|
|
|
|
0
|
last; |
1689
|
|
|
|
|
|
|
} |
1690
|
|
|
|
|
|
|
|
1691
|
0
|
0
|
|
|
|
0
|
next if $depth < $pow; |
1692
|
|
|
|
|
|
|
|
1693
|
0
|
0
|
|
|
|
0
|
if (defined $dbase) { $dbase = $pow; } |
|
0
|
|
|
|
|
0
|
|
1694
|
0
|
|
|
|
|
0
|
$depth -= $pow; |
1695
|
|
|
|
|
|
|
### depth remaining: $depth |
1696
|
|
|
|
|
|
|
|
1697
|
0
|
0
|
|
|
|
0
|
if ($depth == 1) { |
1698
|
|
|
|
|
|
|
### depth=1 is on upper,lower diagonal spine ... |
1699
|
|
|
|
|
|
|
### assert: $n == 1 |
1700
|
0
|
|
|
|
|
0
|
return $pow-3; |
1701
|
|
|
|
|
|
|
} |
1702
|
|
|
|
|
|
|
### assert: $depth >= 2 |
1703
|
|
|
|
|
|
|
|
1704
|
0
|
|
|
|
|
0
|
my $add = _depth_to_octant_added ([$depth],[1], $zero); |
1705
|
|
|
|
|
|
|
### $add |
1706
|
|
|
|
|
|
|
|
1707
|
0
|
0
|
|
|
|
0
|
if ($n < $add) { |
1708
|
|
|
|
|
|
|
### extend part ... |
1709
|
|
|
|
|
|
|
} else { |
1710
|
0
|
|
|
|
|
0
|
$dbase = $pow; |
1711
|
0
|
|
|
|
|
0
|
$n -= 2*$add; |
1712
|
|
|
|
|
|
|
### sub 2add to: $n |
1713
|
|
|
|
|
|
|
|
1714
|
0
|
0
|
|
|
|
0
|
if ($n < 0) { |
1715
|
|
|
|
|
|
|
### upper part, mirror to n: -1 - $n |
1716
|
0
|
|
|
|
|
0
|
$n = -1 - $n; # mirror, $n = $add-1 - $n = -($n-$add) - 1 |
1717
|
|
|
|
|
|
|
} else { |
1718
|
|
|
|
|
|
|
### lower part ... |
1719
|
0
|
|
|
|
|
0
|
$depth += 1; |
1720
|
0
|
|
|
|
|
0
|
$n += 1; # undouble upper,lower spine |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
} |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
} |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
### final ... |
1727
|
|
|
|
|
|
|
### $dbase |
1728
|
|
|
|
|
|
|
### $depth |
1729
|
0
|
0
|
|
|
|
0
|
return (defined $dbase ? $dbase - $depth - 2 : undef); |
1730
|
|
|
|
|
|
|
} |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1733
|
|
|
|
|
|
|
# levels |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
# parts depth |
1736
|
|
|
|
|
|
|
# ----- ----- |
1737
|
|
|
|
|
|
|
# 4 \ |
1738
|
|
|
|
|
|
|
# 3 | 4*2^level - 1 = 3, 7, 15, 31, ... |
1739
|
|
|
|
|
|
|
# wedge | |
1740
|
|
|
|
|
|
|
# two_horiz / |
1741
|
|
|
|
|
|
|
# 2 4*2^level - 2 = 2, 6, 14, 30, ... |
1742
|
|
|
|
|
|
|
# 1 4*2^level - 3 = 1, 5, 13, 29, ... |
1743
|
|
|
|
|
|
|
# octant \ 4*2^level - 4 = 0, 4, 12, 28, ... |
1744
|
|
|
|
|
|
|
# octant_up / |
1745
|
|
|
|
|
|
|
# level=0 level=1 level=2 level=3 |
1746
|
|
|
|
|
|
|
# parts=4 level depths 0, 3, 7 4-1=3, 8-1=7, 16-1=15 |
1747
|
|
|
|
|
|
|
# parts=1 level depths 1 5, 13 2-3=-1 4-3=1, 8-3=5, 16-3=13 |
1748
|
|
|
|
|
|
|
# parts=two_horiz 4-1=3, 8-3=7, 16-4=15 |
1749
|
|
|
|
|
|
|
my %level_depth_offset = (4 => 1, |
1750
|
|
|
|
|
|
|
3 => 1, |
1751
|
|
|
|
|
|
|
2 => 2, |
1752
|
|
|
|
|
|
|
1 => 3, # |
1753
|
|
|
|
|
|
|
octant => 4, # sans upper |
1754
|
|
|
|
|
|
|
octant_up => 4, # |
1755
|
|
|
|
|
|
|
wedge => 1, # |
1756
|
|
|
|
|
|
|
two_horiz => 1, # like parts=4 |
1757
|
|
|
|
|
|
|
); |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
sub level_to_n_range { |
1760
|
52
|
|
|
52
|
1
|
948
|
my ($self, $level) = @_; |
1761
|
52
|
|
|
|
|
140
|
return (0, |
1762
|
|
|
|
|
|
|
$self->tree_depth_to_n_end(2**($level+2) |
1763
|
|
|
|
|
|
|
- $level_depth_offset{$self->{'parts'}})); |
1764
|
|
|
|
|
|
|
} |
1765
|
|
|
|
|
|
|
sub n_to_level { |
1766
|
44
|
|
|
44
|
1
|
2356
|
my ($self, $n) = @_; |
1767
|
44
|
|
|
|
|
55
|
my $depth = $self->tree_n_to_depth($n); |
1768
|
44
|
50
|
|
|
|
60
|
if (! defined $depth) { return undef; } |
|
0
|
|
|
|
|
0
|
|
1769
|
44
|
|
|
|
|
98
|
my ($pow, $exp) = round_down_pow |
1770
|
|
|
|
|
|
|
($depth + $level_depth_offset{$self->{'parts'}} - 1, |
1771
|
|
|
|
|
|
|
2); |
1772
|
44
|
|
|
|
|
335
|
return max(0, $exp - 1); |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1776
|
|
|
|
|
|
|
1; |
1777
|
|
|
|
|
|
|
__END__ |