| 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
|
|
3424
|
use 5.004; |
|
|
2
|
|
|
|
|
6
|
|
|
127
|
2
|
|
|
2
|
|
11
|
use strict; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
48
|
|
|
128
|
2
|
|
|
2
|
|
10
|
use Carp 'croak'; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
166
|
|
|
129
|
|
|
|
|
|
|
#use List::Util 'max','min'; |
|
130
|
|
|
|
|
|
|
*max = \&Math::PlanePath::_max; |
|
131
|
|
|
|
|
|
|
*min = \&Math::PlanePath::_min; |
|
132
|
|
|
|
|
|
|
|
|
133
|
2
|
|
|
2
|
|
8
|
use vars '$VERSION', '@ISA'; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
114
|
|
|
134
|
|
|
|
|
|
|
$VERSION = 18; |
|
135
|
2
|
|
|
2
|
|
1139
|
use Math::PlanePath; |
|
|
2
|
|
|
|
|
6850
|
|
|
|
2
|
|
|
|
|
77
|
|
|
136
|
|
|
|
|
|
|
@ISA = ('Math::PlanePath'); |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
use Math::PlanePath::Base::Generic |
|
139
|
2
|
|
|
|
|
91
|
'is_infinite', |
|
140
|
2
|
|
|
2
|
|
11
|
'round_nearest'; |
|
|
2
|
|
|
|
|
4
|
|
|
141
|
|
|
|
|
|
|
use Math::PlanePath::Base::Digits |
|
142
|
2
|
|
|
2
|
|
742
|
'round_down_pow'; |
|
|
2
|
|
|
|
|
1692
|
|
|
|
2
|
|
|
|
|
98
|
|
|
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
|
|
10
|
use constant n_start => 0; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
180
|
|
|
151
|
2
|
|
|
|
|
109
|
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
|
|
9
|
]; |
|
|
2
|
|
|
|
|
13
|
|
|
166
|
|
|
|
|
|
|
|
|
167
|
2
|
|
|
2
|
|
10
|
use constant class_x_negative => 1; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
84
|
|
|
168
|
2
|
|
|
2
|
|
9
|
use constant class_y_negative => 1; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
1296
|
|
|
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
|
50
|
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
|
2
|
my ($self) = @_; |
|
208
|
1
|
|
|
|
|
4
|
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
|
|
12
|
use constant tree_num_children_list => (0,1,2); |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
11009
|
|
|
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
|
8429
|
my $self = shift->SUPER::new(@_); |
|
360
|
41
|
|
100
|
|
|
365
|
my $parts = ($self->{'parts'} ||= 4); |
|
361
|
41
|
50
|
|
|
|
132
|
if (! exists $parts_depth_adjust{$parts}) { |
|
362
|
0
|
|
|
|
|
0
|
croak "Unrecognised parts: ",$parts; |
|
363
|
|
|
|
|
|
|
} |
|
364
|
41
|
|
|
|
|
96
|
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
|
33476
|
my ($self, $n) = @_; |
|
386
|
|
|
|
|
|
|
### ToothpickTree n_to_xy(): $n |
|
387
|
|
|
|
|
|
|
|
|
388
|
319
|
50
|
|
|
|
767
|
if ($n < 0) { return; } |
|
|
0
|
|
|
|
|
0
|
|
|
389
|
319
|
50
|
|
|
|
794
|
if (is_infinite($n)) { return ($n,$n); } |
|
|
0
|
|
|
|
|
0
|
|
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
{ |
|
392
|
319
|
|
|
|
|
2010
|
my $int = int($n); |
|
|
319
|
|
|
|
|
425
|
|
|
393
|
|
|
|
|
|
|
### $int |
|
394
|
|
|
|
|
|
|
### $n |
|
395
|
319
|
50
|
|
|
|
590
|
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
|
|
|
|
|
454
|
$n = $int; # BigFloat int() gives BigInt, use that |
|
404
|
|
|
|
|
|
|
} |
|
405
|
319
|
|
|
|
|
398
|
my $zero = $n*0; |
|
406
|
|
|
|
|
|
|
|
|
407
|
319
|
|
|
|
|
491
|
my $parts = $self->{'parts'}; |
|
408
|
|
|
|
|
|
|
|
|
409
|
319
|
100
|
|
|
|
953
|
if (my $initial = $initial_n_to_xy{$parts}) { |
|
410
|
238
|
100
|
|
|
|
567
|
if ($n <= $#$initial) { |
|
411
|
|
|
|
|
|
|
### initial_n_to_xy{}: $initial->[$n] |
|
412
|
32
|
|
|
|
|
37
|
return @{$initial->[$n]}; |
|
|
32
|
|
|
|
|
111
|
|
|
413
|
|
|
|
|
|
|
} |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
287
|
|
|
|
|
555
|
(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
|
|
|
|
|
423
|
my $x = 0; |
|
432
|
287
|
|
|
|
|
323
|
my $y = 0; |
|
433
|
287
|
|
|
|
|
329
|
my $hdx = 1; |
|
434
|
287
|
|
|
|
|
313
|
my $hdy = 0; |
|
435
|
287
|
|
|
|
|
300
|
my $vdx = 0; |
|
436
|
287
|
|
|
|
|
282
|
my $vdy = 1; |
|
437
|
287
|
|
|
|
|
312
|
my $mirror = 0; |
|
438
|
287
|
|
|
|
|
403
|
$depth += $parts_depth_adjust{$parts}; |
|
439
|
|
|
|
|
|
|
### depth in parts=4 style: $depth |
|
440
|
|
|
|
|
|
|
|
|
441
|
287
|
50
|
|
|
|
1019
|
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
|
|
|
|
|
807
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
|
513
|
|
|
|
|
|
|
### $add |
|
514
|
|
|
|
|
|
|
|
|
515
|
287
|
100
|
|
|
|
793
|
if ($parts eq '3') { |
|
516
|
59
|
|
|
|
|
164
|
my $add_plus1 = _depth_to_octant_added([$depth+1],[1],$zero); |
|
517
|
59
|
|
|
|
|
112
|
my $add_quad = $add_plus1 + $add - 1; |
|
518
|
|
|
|
|
|
|
### parts=3 lower quad: $add_quad |
|
519
|
59
|
100
|
|
|
|
107
|
if ($n < $add_quad) { |
|
520
|
|
|
|
|
|
|
### initial block 1, rotate 90 ... |
|
521
|
23
|
|
|
|
|
25
|
$depth += 1; |
|
522
|
23
|
|
|
|
|
26
|
$add = $add_plus1; |
|
523
|
23
|
|
|
|
|
27
|
$x = -1; |
|
524
|
23
|
|
|
|
|
37
|
$hdx = 0; $hdy = -1; $vdx = 1; $vdy = 0; |
|
|
23
|
|
|
|
|
27
|
|
|
|
23
|
|
|
|
|
23
|
|
|
|
23
|
|
|
|
|
24
|
|
|
525
|
23
|
|
|
|
|
39
|
$parts = '1'; |
|
526
|
|
|
|
|
|
|
} else { |
|
527
|
|
|
|
|
|
|
# now parts=2 style remaining |
|
528
|
36
|
|
|
|
|
59
|
$n -= $add_quad; |
|
529
|
|
|
|
|
|
|
} |
|
530
|
|
|
|
|
|
|
} |
|
531
|
|
|
|
|
|
|
|
|
532
|
287
|
100
|
|
|
|
650
|
if ($parts ne '1') { |
|
533
|
183
|
|
|
|
|
479
|
my $add_sub1 = _depth_to_octant_added([$depth-1], [1], $zero); |
|
534
|
183
|
|
|
|
|
350
|
my $add_quad = $add + $add_sub1 - 1; |
|
535
|
|
|
|
|
|
|
|
|
536
|
183
|
100
|
|
|
|
383
|
if ($parts eq '4') { |
|
537
|
85
|
|
|
|
|
116
|
my $add_half = 2*$add_quad; |
|
538
|
85
|
100
|
|
|
|
179
|
if ($n >= $add_half) { |
|
539
|
38
|
|
|
|
|
43
|
$n -= $add_half; |
|
540
|
38
|
|
|
|
|
41
|
$hdx = -1; $vdy = -1; # rotate 180 |
|
|
38
|
|
|
|
|
57
|
|
|
541
|
|
|
|
|
|
|
} |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# parts=2 style two quadrants |
|
545
|
183
|
100
|
|
|
|
382
|
if ($n >= $add_quad) { |
|
546
|
|
|
|
|
|
|
### second quadrant ... |
|
547
|
88
|
|
|
|
|
99
|
$n -= $add_quad; |
|
548
|
|
|
|
|
|
|
|
|
549
|
88
|
100
|
|
|
|
142
|
if ($n >= $add_sub1) { |
|
550
|
|
|
|
|
|
|
### fourth octant ... |
|
551
|
22
|
|
|
|
|
28
|
$n -= $add_sub1; |
|
552
|
22
|
|
|
|
|
25
|
$n += 1; # unduplicate diagonal |
|
553
|
22
|
|
|
|
|
26
|
$mirror = 1; |
|
554
|
22
|
|
|
|
|
28
|
$hdx = -$hdx; $hdy = -$hdy; # reflect horizontally |
|
|
22
|
|
|
|
|
31
|
|
|
555
|
|
|
|
|
|
|
} else { |
|
556
|
|
|
|
|
|
|
### third octant ... |
|
557
|
66
|
|
|
|
|
84
|
$depth -= 1; |
|
558
|
66
|
|
|
|
|
114
|
($hdx,$hdy, $vdx,$vdy) # rotate -90 |
|
559
|
|
|
|
|
|
|
= ($vdx,$vdy, -$hdx,-$hdy); |
|
560
|
66
|
|
|
|
|
102
|
$x += $hdx; |
|
561
|
66
|
|
|
|
|
85
|
$y += $hdy; |
|
562
|
|
|
|
|
|
|
} |
|
563
|
88
|
|
|
|
|
128
|
$add = $n+1; |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
} |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
### first quadrant split: "add=$add n=$n depth=$depth" |
|
568
|
287
|
100
|
|
|
|
590
|
if ($n >= $add) { |
|
569
|
|
|
|
|
|
|
### top half of quad ... |
|
570
|
47
|
|
|
|
|
57
|
$depth -= 1; |
|
571
|
47
|
|
|
|
|
54
|
$n -= $add; |
|
572
|
47
|
|
|
|
|
58
|
$n += 1; # unduplicate diagonal |
|
573
|
47
|
|
|
|
|
61
|
$mirror ^= 1; |
|
574
|
47
|
|
|
|
|
56
|
$x += $vdx; |
|
575
|
47
|
|
|
|
|
56
|
$y += $vdy; |
|
576
|
47
|
|
|
|
|
107
|
($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
|
|
|
|
|
705
|
my ($pow,$exp) = round_down_pow ($depth, 2); |
|
584
|
287
|
|
|
|
|
2912
|
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
|
|
|
|
886
|
if ($depth < $pow) { |
|
588
|
|
|
|
|
|
|
### block 0 ... |
|
589
|
41
|
|
|
|
|
92
|
next; |
|
590
|
|
|
|
|
|
|
} |
|
591
|
428
|
|
|
|
|
465
|
$depth -= $pow; |
|
592
|
|
|
|
|
|
|
|
|
593
|
428
|
100
|
|
|
|
860
|
if ($depth == $pow-1) { |
|
594
|
|
|
|
|
|
|
### pow-1 end toothpick ... |
|
595
|
48
|
|
|
|
|
73
|
$x += $pow * ($hdx + $vdx) - $hdx; |
|
596
|
48
|
|
|
|
|
69
|
$y += $pow * ($hdy + $vdy) - $hdy; |
|
597
|
48
|
|
|
|
|
57
|
last; |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
|
|
600
|
380
|
|
|
|
|
552
|
$x += $pow/2 * ($hdx + $vdx); |
|
601
|
380
|
|
|
|
|
555
|
$y += $pow/2 * ($hdy + $vdy); |
|
602
|
|
|
|
|
|
|
### diagonal to: "depth=$depth xy=$x,$y" |
|
603
|
|
|
|
|
|
|
|
|
604
|
380
|
100
|
|
|
|
730
|
if ($depth == 0) { |
|
605
|
|
|
|
|
|
|
### toothpick A ... |
|
606
|
134
|
|
|
|
|
155
|
last; |
|
607
|
|
|
|
|
|
|
} |
|
608
|
246
|
100
|
|
|
|
455
|
if ($depth == 1) { |
|
609
|
|
|
|
|
|
|
### toothpick B,other up,down ... |
|
610
|
105
|
100
|
66
|
|
|
409
|
if ($exp && $n == $mirror) { |
|
611
|
|
|
|
|
|
|
### toothpick other (down): "subtract vdxdy=$vdx,$vdy" |
|
612
|
72
|
|
|
|
|
85
|
$x -= $vdx; |
|
613
|
72
|
|
|
|
|
93
|
$y -= $vdy; |
|
614
|
|
|
|
|
|
|
} else { |
|
615
|
|
|
|
|
|
|
### toothpick B (up): "add vdxdy=$vdx,$vdy" |
|
616
|
33
|
|
|
|
|
36
|
$x += $vdx; |
|
617
|
33
|
|
|
|
|
38
|
$y += $vdy; |
|
618
|
|
|
|
|
|
|
} |
|
619
|
105
|
|
|
|
|
131
|
last; |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
141
|
100
|
|
|
|
250
|
if ($mirror) { |
|
623
|
|
|
|
|
|
|
# / |
|
624
|
|
|
|
|
|
|
# /3 |
|
625
|
|
|
|
|
|
|
# /-- |
|
626
|
|
|
|
|
|
|
# /|\2 |
|
627
|
|
|
|
|
|
|
# /0|1\ |
|
628
|
45
|
|
|
|
|
122
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
|
629
|
|
|
|
|
|
|
### add in mirror block2,3: $add |
|
630
|
|
|
|
|
|
|
|
|
631
|
45
|
100
|
|
|
|
122
|
if ($n < $add) { |
|
632
|
|
|
|
|
|
|
### mirror block 3, same ... |
|
633
|
3
|
|
|
|
|
10
|
next; |
|
634
|
|
|
|
|
|
|
} |
|
635
|
42
|
|
|
|
|
53
|
$n -= $add; |
|
636
|
|
|
|
|
|
|
|
|
637
|
42
|
100
|
|
|
|
95
|
if ($n < $add) { |
|
638
|
|
|
|
|
|
|
### mirror block 2, unmirror, vertical invert ... |
|
639
|
37
|
|
|
|
|
43
|
$vdx = -$vdx; |
|
640
|
37
|
|
|
|
|
49
|
$vdy = -$vdy; |
|
641
|
37
|
|
|
|
|
49
|
$mirror = 0; |
|
642
|
37
|
|
|
|
|
107
|
next; |
|
643
|
|
|
|
|
|
|
} |
|
644
|
5
|
|
|
|
|
6
|
$n -= $add; |
|
645
|
5
|
|
|
|
|
8
|
$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
|
|
|
|
|
8
|
$depth += 1; |
|
650
|
5
|
|
|
|
|
5
|
$x -= $hdx; # offset |
|
651
|
5
|
|
|
|
|
6
|
$y -= $hdy; |
|
652
|
5
|
|
|
|
|
21
|
($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
|
|
|
|
223
|
if ($depth+1 < $pow) { |
|
664
|
96
|
|
|
|
|
249
|
my $add = _depth_to_octant_added([$depth+1],[1],$zero) - 1; |
|
665
|
|
|
|
|
|
|
### add in block1, sans diagonal: $add |
|
666
|
96
|
100
|
|
|
|
227
|
if ($n < $add) { |
|
667
|
|
|
|
|
|
|
### block 1 "lower", rotate +90 ... |
|
668
|
7
|
|
|
|
|
9
|
$depth += 1; |
|
669
|
7
|
|
|
|
|
11
|
$x -= $hdx; # offset |
|
670
|
7
|
|
|
|
|
8
|
$y -= $hdy; |
|
671
|
7
|
|
|
|
|
15
|
($hdx,$hdy, $vdx,$vdy) # rotate 90 in direction v toward h |
|
672
|
|
|
|
|
|
|
= (-$vdx,-$vdy, $hdx,$hdy); |
|
673
|
7
|
|
|
|
|
20
|
next; |
|
674
|
|
|
|
|
|
|
} |
|
675
|
89
|
|
|
|
|
130
|
$n -= $add; |
|
676
|
|
|
|
|
|
|
} |
|
677
|
|
|
|
|
|
|
|
|
678
|
89
|
|
|
|
|
213
|
my $add = _depth_to_octant_added([$depth],[1],$zero); |
|
679
|
|
|
|
|
|
|
### add in block2: $add |
|
680
|
|
|
|
|
|
|
|
|
681
|
89
|
100
|
|
|
|
227
|
if ($n < $add) { |
|
682
|
|
|
|
|
|
|
### block 2 "upper", vertical invert ... |
|
683
|
47
|
|
|
|
|
58
|
$vdx = -$vdx; |
|
684
|
47
|
|
|
|
|
55
|
$vdy = -$vdy; |
|
685
|
47
|
|
|
|
|
137
|
$mirror = 1; |
|
686
|
|
|
|
|
|
|
} else { |
|
687
|
|
|
|
|
|
|
### block 3 "extend", same ... |
|
688
|
42
|
|
|
|
|
111
|
$n -= $add; |
|
689
|
|
|
|
|
|
|
### assert: $n < $add |
|
690
|
|
|
|
|
|
|
} |
|
691
|
|
|
|
|
|
|
} |
|
692
|
|
|
|
|
|
|
} |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
### n_to_xy() return: "$x,$y (depth=$depth n=$n)" |
|
695
|
287
|
|
|
|
|
757
|
return ($x,$y); |
|
696
|
|
|
|
|
|
|
} |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
sub xy_to_n { |
|
699
|
252
|
|
|
252
|
1
|
20794
|
my ($self, $x, $y) = @_; |
|
700
|
|
|
|
|
|
|
### ToothpickTree xy_to_n(): "$x, $y" |
|
701
|
|
|
|
|
|
|
|
|
702
|
252
|
|
|
|
|
629
|
$x = round_nearest ($x); |
|
703
|
252
|
|
|
|
|
1836
|
$y = round_nearest ($y); |
|
704
|
|
|
|
|
|
|
|
|
705
|
252
|
|
|
|
|
1510
|
my $zero = $x * 0 * $y; |
|
706
|
252
|
|
|
|
|
304
|
my $n = $zero; |
|
707
|
252
|
|
|
|
|
284
|
my @add_offset; |
|
708
|
|
|
|
|
|
|
my @add_mult; |
|
709
|
252
|
|
|
|
|
274
|
my $mirror = 0; |
|
710
|
252
|
|
|
|
|
286
|
my $depth = 0; |
|
711
|
252
|
|
|
|
|
283
|
my $depth_adjust = 0; |
|
712
|
|
|
|
|
|
|
|
|
713
|
252
|
|
|
|
|
372
|
my $parts = $self->{'parts'}; |
|
714
|
|
|
|
|
|
|
|
|
715
|
252
|
50
|
|
|
|
950
|
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
|
|
|
|
724
|
if ($parts eq '1') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
805
|
51
|
50
|
33
|
|
|
232
|
if ($x < 1 || $y < 1) { return undef; } |
|
|
0
|
|
|
|
|
0
|
|
|
806
|
51
|
|
|
|
|
67
|
$depth_adjust = 2; |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
} elsif ($parts eq '2') { |
|
809
|
51
|
50
|
|
|
|
106
|
if ($y < 1) { return undef; } |
|
|
0
|
|
|
|
|
0
|
|
|
810
|
51
|
100
|
|
|
|
98
|
if ($x == 0) { |
|
811
|
1
|
50
|
|
|
|
11
|
if ($y == 1) { return 0; } |
|
|
1
|
|
|
|
|
3
|
|
|
812
|
|
|
|
|
|
|
} |
|
813
|
50
|
100
|
|
|
|
98
|
if ($y == 1) { |
|
814
|
8
|
100
|
|
|
|
16
|
if ($x == 1) { return 1; } |
|
|
1
|
|
|
|
|
3
|
|
|
815
|
7
|
100
|
|
|
|
16
|
if ($x == -1) { return 2; } |
|
|
1
|
|
|
|
|
4
|
|
|
816
|
|
|
|
|
|
|
} |
|
817
|
48
|
|
|
|
|
68
|
$depth_adjust = 1; |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
} elsif ($parts eq '3') { |
|
820
|
51
|
100
|
|
|
|
106
|
if ($x == 0) { |
|
821
|
5
|
100
|
|
|
|
10
|
if ($y == 0) { return 0; } |
|
|
1
|
|
|
|
|
4
|
|
|
822
|
4
|
100
|
|
|
|
11
|
if ($y == -1) { return 1; } |
|
|
1
|
|
|
|
|
3
|
|
|
823
|
3
|
100
|
|
|
|
8
|
if ($y == 1) { return 2; } |
|
|
1
|
|
|
|
|
3
|
|
|
824
|
|
|
|
|
|
|
} |
|
825
|
48
|
100
|
|
|
|
86
|
if ($y < 0) { |
|
826
|
18
|
50
|
|
|
|
35
|
if ($x < 0) { |
|
827
|
0
|
|
|
|
|
0
|
return undef; |
|
828
|
|
|
|
|
|
|
} |
|
829
|
|
|
|
|
|
|
### parts=3 rotate +90 ... |
|
830
|
18
|
|
|
|
|
30
|
($x,$y) = (-$y,$x+1); |
|
831
|
18
|
|
|
|
|
27
|
$depth_adjust = 1; |
|
832
|
|
|
|
|
|
|
} else { |
|
833
|
30
|
|
|
|
|
42
|
push @add_offset, -1,0; # one quadrant |
|
834
|
30
|
|
|
|
|
42
|
push @add_mult, 1,1; |
|
835
|
30
|
|
|
|
|
41
|
$n -= 1; # unduplicate shared diagonal |
|
836
|
|
|
|
|
|
|
} |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
} else { |
|
839
|
|
|
|
|
|
|
### assert: $parts eq '4' |
|
840
|
99
|
100
|
|
|
|
237
|
if ($x == 0) { |
|
841
|
6
|
100
|
|
|
|
13
|
if ($y == 0) { return 0; } |
|
|
2
|
|
|
|
|
7
|
|
|
842
|
4
|
100
|
|
|
|
11
|
if ($y == 1) { return 1; } |
|
|
2
|
|
|
|
|
7
|
|
|
843
|
2
|
50
|
|
|
|
6
|
if ($y == -1) { return 2; } |
|
|
2
|
|
|
|
|
6
|
|
|
844
|
|
|
|
|
|
|
} |
|
845
|
93
|
100
|
|
|
|
208
|
if ($y < 0) { |
|
846
|
42
|
|
|
|
|
60
|
$x = -$x; $y = -$y; # rotate 180 |
|
|
42
|
|
|
|
|
51
|
|
|
847
|
42
|
|
|
|
|
67
|
push @add_offset, 0,1; # two quadrants |
|
848
|
42
|
|
|
|
|
73
|
push @add_mult, 2,2; |
|
849
|
42
|
|
|
|
|
61
|
$n -= 2; # unduplicate shared diagonal |
|
850
|
|
|
|
|
|
|
} |
|
851
|
|
|
|
|
|
|
} |
|
852
|
|
|
|
|
|
|
|
|
853
|
240
|
100
|
|
|
|
469
|
if ($x < 0) { |
|
854
|
|
|
|
|
|
|
### X negative mirror ... |
|
855
|
82
|
|
|
|
|
106
|
$x = -$x; |
|
856
|
82
|
|
|
|
|
86
|
$mirror = 1; |
|
857
|
82
|
|
|
|
|
117
|
push @add_offset, 0,1; # one quadrant |
|
858
|
82
|
|
|
|
|
101
|
push @add_mult, 1,1; |
|
859
|
82
|
|
|
|
|
119
|
$n -= 1; # unduplicate shared diagonal |
|
860
|
|
|
|
|
|
|
} |
|
861
|
|
|
|
|
|
|
|
|
862
|
240
|
100
|
|
|
|
439
|
if ($y <= $x) { |
|
863
|
|
|
|
|
|
|
### lower octant ... |
|
864
|
126
|
100
|
|
|
|
251
|
if ($mirror) { |
|
865
|
42
|
|
|
|
|
50
|
push @add_offset, 1; |
|
866
|
42
|
|
|
|
|
56
|
push @add_mult, 1; |
|
867
|
42
|
|
|
|
|
58
|
$n -= 1; # unduplicate shared diagonal |
|
868
|
|
|
|
|
|
|
} |
|
869
|
|
|
|
|
|
|
} else { |
|
870
|
|
|
|
|
|
|
### upper octant ... |
|
871
|
114
|
|
|
|
|
236
|
($x,$y) = ($y-1,$x); |
|
872
|
114
|
|
|
|
|
240
|
foreach (@add_offset) { $_-- } |
|
|
148
|
|
|
|
|
214
|
|
|
873
|
114
|
|
|
|
|
181
|
$depth_adjust--; |
|
874
|
114
|
100
|
|
|
|
228
|
if (! $mirror) { |
|
875
|
74
|
|
|
|
|
106
|
push @add_offset, -1; |
|
876
|
74
|
|
|
|
|
88
|
push @add_mult, 1; |
|
877
|
74
|
|
|
|
|
96
|
$n -= 1; # unduplicate shared diagonal |
|
878
|
|
|
|
|
|
|
} |
|
879
|
114
|
|
|
|
|
167
|
$mirror ^= 1; |
|
880
|
|
|
|
|
|
|
} |
|
881
|
|
|
|
|
|
|
} |
|
882
|
|
|
|
|
|
|
### $depth_adjust |
|
883
|
|
|
|
|
|
|
### xy: "$x,$y" |
|
884
|
|
|
|
|
|
|
|
|
885
|
240
|
50
|
33
|
|
|
1524
|
if ($x < 1|| $y < 1 || $y > $x+1) { |
|
|
|
|
33
|
|
|
|
|
|
886
|
0
|
|
|
|
|
0
|
return undef; |
|
887
|
|
|
|
|
|
|
} |
|
888
|
|
|
|
|
|
|
|
|
889
|
240
|
|
|
|
|
656
|
my ($pow,$exp) = round_down_pow (max($x,$y-1), 2); |
|
890
|
240
|
|
|
|
|
3869
|
$pow *= 2; |
|
891
|
240
|
50
|
|
|
|
597
|
if (is_infinite($exp)) { |
|
892
|
0
|
|
|
|
|
0
|
return ($exp); |
|
893
|
|
|
|
|
|
|
} |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# / |
|
896
|
|
|
|
|
|
|
# /3 |
|
897
|
|
|
|
|
|
|
# /-- |
|
898
|
|
|
|
|
|
|
# /|\2 |
|
899
|
|
|
|
|
|
|
# /0|1\ |
|
900
|
|
|
|
|
|
|
|
|
901
|
240
|
|
|
|
|
1457
|
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
|
|
|
|
981
|
if ($x < $pow) { |
|
925
|
267
|
50
|
33
|
|
|
676
|
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
|
|
|
|
|
293
|
$x -= $pow; |
|
934
|
259
|
|
|
|
|
292
|
$y -= $pow; |
|
935
|
259
|
|
|
|
|
329
|
$depth += 2*$pow; |
|
936
|
|
|
|
|
|
|
|
|
937
|
259
|
100
|
|
|
|
557
|
if ($y == 0) { |
|
|
|
100
|
|
|
|
|
|
|
938
|
67
|
50
|
|
|
|
113
|
if ($x == 0) { |
|
939
|
|
|
|
|
|
|
### toothpick B, stop ... |
|
940
|
67
|
|
|
|
|
81
|
last; |
|
941
|
|
|
|
|
|
|
} else { |
|
942
|
0
|
|
|
|
|
0
|
return undef; |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} elsif ($y > 0) { |
|
946
|
|
|
|
|
|
|
### block 3, same ... |
|
947
|
57
|
50
|
66
|
|
|
229
|
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
|
|
|
|
116
|
if (! $mirror) { |
|
956
|
30
|
|
|
|
|
39
|
push @add_offset, $depth-1, $depth; # past block 1,2 |
|
957
|
30
|
|
|
|
|
40
|
push @add_mult, 1, 1; |
|
958
|
30
|
|
|
|
|
43
|
$n -= 1; # unduplicate shared diagonal |
|
959
|
|
|
|
|
|
|
} |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
} else { |
|
962
|
135
|
100
|
100
|
|
|
520
|
if ($y == -1 && $x == 0) { |
|
963
|
|
|
|
|
|
|
### middle below point, stop ... |
|
964
|
56
|
|
|
|
|
60
|
$depth += 1; |
|
965
|
56
|
100
|
|
|
|
100
|
if ($mirror) { |
|
966
|
28
|
|
|
|
|
33
|
$n += 1; |
|
967
|
|
|
|
|
|
|
} |
|
968
|
56
|
|
|
|
|
80
|
last; |
|
969
|
|
|
|
|
|
|
} |
|
970
|
79
|
100
|
|
|
|
146
|
if ($x >= -$y) { |
|
971
|
|
|
|
|
|
|
### block 2, vertical flip mirror ... |
|
972
|
59
|
50
|
|
|
|
103
|
if ($y > -1) { |
|
973
|
0
|
|
|
|
|
0
|
return undef; # no such point |
|
974
|
|
|
|
|
|
|
} |
|
975
|
59
|
|
|
|
|
77
|
$y = -$y; |
|
976
|
59
|
100
|
|
|
|
96
|
if ($mirror) { |
|
977
|
28
|
|
|
|
|
38
|
push @add_offset, $depth; # past block 3 |
|
978
|
28
|
|
|
|
|
39
|
push @add_mult, 1; |
|
979
|
|
|
|
|
|
|
} else { |
|
980
|
31
|
|
|
|
|
43
|
push @add_offset, $depth-1; # past block 1 |
|
981
|
31
|
|
|
|
|
38
|
push @add_mult, 1; |
|
982
|
31
|
|
|
|
|
39
|
$n -= 1; # unduplicate shared diagonal |
|
983
|
|
|
|
|
|
|
} |
|
984
|
59
|
|
|
|
|
83
|
$mirror ^= 1; |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
} else { |
|
987
|
|
|
|
|
|
|
### block 1, rotate and offset ... |
|
988
|
20
|
|
|
|
|
25
|
$depth -= 1; |
|
989
|
20
|
|
|
|
|
33
|
($x,$y) = (-$y,$x+1); # rotate +90, offset |
|
990
|
20
|
100
|
|
|
|
44
|
if ($mirror) { |
|
991
|
8
|
|
|
|
|
11
|
push @add_offset, $depth+1; # past block 3,2 |
|
992
|
8
|
|
|
|
|
10
|
push @add_mult, 2; |
|
993
|
8
|
|
|
|
|
13
|
$n -= 1; # unduplicate shared diagonal 2,1 |
|
994
|
|
|
|
|
|
|
} |
|
995
|
|
|
|
|
|
|
} |
|
996
|
|
|
|
|
|
|
} |
|
997
|
|
|
|
|
|
|
} |
|
998
|
|
|
|
|
|
|
|
|
999
|
403
|
100
|
|
|
|
863
|
if (--$exp < 0) { |
|
1000
|
|
|
|
|
|
|
### final xy: "$x,$y" |
|
1001
|
117
|
50
|
33
|
|
|
429
|
if ($x == 1 && $y == 1) { |
|
|
|
0
|
0
|
|
|
|
|
|
1002
|
117
|
|
|
|
|
142
|
$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
|
|
|
|
|
170
|
last; |
|
1010
|
|
|
|
|
|
|
} |
|
1011
|
286
|
|
|
|
|
360
|
$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
|
|
|
|
|
597
|
$n += $self->tree_depth_to_n($depth - $depth_adjust); |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
240
|
100
|
|
|
|
553
|
if (@add_offset) { |
|
1023
|
210
|
|
|
|
|
330
|
foreach my $add_offset (@add_offset) { |
|
1024
|
551
|
|
|
|
|
757
|
$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
|
|
|
|
|
441
|
$n += _depth_to_octant_added (\@add_offset, \@add_mult, $zero); |
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
### xy_to_n() return n: $n |
|
1033
|
240
|
|
|
|
|
749
|
return $n; |
|
1034
|
|
|
|
|
|
|
} |
|
1035
|
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# Shared with ToothpickReplicate. |
|
1038
|
|
|
|
|
|
|
# not exact |
|
1039
|
|
|
|
|
|
|
sub rect_to_n_range { |
|
1040
|
108
|
|
|
108
|
1
|
8500
|
my ($self, $x1,$y1, $x2,$y2) = @_; |
|
1041
|
|
|
|
|
|
|
### ToothpickTree rect_to_n_range(): "$x1,$y1 $x2,$y2" |
|
1042
|
|
|
|
|
|
|
|
|
1043
|
108
|
|
|
|
|
252
|
$x1 = round_nearest ($x1); |
|
1044
|
108
|
|
|
|
|
695
|
$y1 = round_nearest ($y1); |
|
1045
|
108
|
|
|
|
|
656
|
$x2 = round_nearest ($x2); |
|
1046
|
108
|
|
|
|
|
672
|
$y2 = round_nearest ($y2); |
|
1047
|
|
|
|
|
|
|
|
|
1048
|
108
|
100
|
|
|
|
629
|
($x1,$x2) = ($x2,$x1) if $x1 > $x2; |
|
1049
|
108
|
100
|
|
|
|
190
|
($y1,$y2) = ($y2,$y1) if $y1 > $y2; |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
108
|
|
|
|
|
140
|
my $parts = $self->{'parts'}; |
|
1052
|
108
|
50
|
33
|
|
|
448
|
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
|
|
|
381
|
if ($parts eq '4' || $parts eq 'two_horiz') { |
|
1058
|
22
|
50
|
|
|
|
43
|
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
|
|
|
|
|
60
|
my ($len,$level) = round_down_pow (max(-$x1, |
|
1065
|
|
|
|
|
|
|
$x2, |
|
1066
|
|
|
|
|
|
|
-1-$y1, |
|
1067
|
|
|
|
|
|
|
$y2-1), |
|
1068
|
|
|
|
|
|
|
2); |
|
1069
|
22
|
|
|
|
|
329
|
return (0, (32*$len*$len-2)/3); |
|
1070
|
|
|
|
|
|
|
} |
|
1071
|
|
|
|
|
|
|
|
|
1072
|
86
|
100
|
|
|
|
154
|
if ($parts eq '3') { |
|
1073
|
16
|
50
|
66
|
|
|
38
|
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
|
|
|
|
|
51
|
my ($len,$level) = round_down_pow (max(-$x1, |
|
1086
|
|
|
|
|
|
|
$x2, |
|
1087
|
|
|
|
|
|
|
-$y1, |
|
1088
|
|
|
|
|
|
|
$y2-1), |
|
1089
|
|
|
|
|
|
|
2); |
|
1090
|
16
|
|
|
|
|
239
|
return (0, 8*$len*$len); |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
} |
|
1093
|
70
|
50
|
|
|
|
127
|
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
|
|
|
295
|
if ($x2 < 1 || $y2 < 1) { |
|
1107
|
0
|
|
|
|
|
0
|
return (1,0); |
|
1108
|
|
|
|
|
|
|
} |
|
1109
|
70
|
|
|
|
|
168
|
my ($len,$level) = round_down_pow (max($x2, $y2-1), |
|
1110
|
|
|
|
|
|
|
2); |
|
1111
|
70
|
|
|
|
|
1123
|
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
|
4288
|
my ($self, $n) = @_; |
|
1180
|
|
|
|
|
|
|
### tree_n_to_depth(): "$n" |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
882
|
50
|
|
|
|
1722
|
if ($n < 0) { |
|
1183
|
0
|
|
|
|
|
0
|
return undef; |
|
1184
|
|
|
|
|
|
|
} |
|
1185
|
882
|
|
|
|
|
1663
|
my ($depth) = _n0_to_depth_and_rem($self, int($n)); |
|
1186
|
|
|
|
|
|
|
### n0 depth: $depth |
|
1187
|
882
|
|
|
|
|
1891
|
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
|
|
1535
|
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
|
|
|
|
|
2982
|
my ($pow,$exp) = round_down_pow (12*$n, # /$self->{'parts'} |
|
1208
|
|
|
|
|
|
|
4); |
|
1209
|
1169
|
50
|
|
|
|
12149
|
if (is_infinite($exp)) { |
|
1210
|
0
|
|
|
|
|
0
|
return ($exp,0); |
|
1211
|
|
|
|
|
|
|
} |
|
1212
|
|
|
|
|
|
|
### $pow |
|
1213
|
|
|
|
|
|
|
### $exp |
|
1214
|
|
|
|
|
|
|
|
|
1215
|
1169
|
|
|
|
|
7106
|
my $depth = 0; |
|
1216
|
1169
|
|
|
|
|
1346
|
my $n_depth = 0; |
|
1217
|
1169
|
|
|
|
|
1319
|
$pow = 2 ** $exp; # pow=2^exp down to 1, inclusive |
|
1218
|
|
|
|
|
|
|
|
|
1219
|
1169
|
|
|
|
|
2555
|
while ($exp-- >= 0) { |
|
1220
|
6021
|
|
|
|
|
8174
|
my $try_depth = $depth + $pow; |
|
1221
|
6021
|
|
|
|
|
11854
|
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
|
|
|
|
12280
|
if ($try_n_depth <= $n) { |
|
1229
|
|
|
|
|
|
|
### use this tried depth ... |
|
1230
|
2808
|
|
|
|
|
2881
|
$depth = $try_depth; |
|
1231
|
2808
|
|
|
|
|
3589
|
$n_depth = $try_n_depth; |
|
1232
|
|
|
|
|
|
|
} |
|
1233
|
6021
|
|
|
|
|
13762
|
$pow /= 2; |
|
1234
|
|
|
|
|
|
|
} |
|
1235
|
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
### _n0_to_depth_and_rem() final ... |
|
1237
|
|
|
|
|
|
|
### $depth |
|
1238
|
|
|
|
|
|
|
### remainder: $n - $n_depth |
|
1239
|
|
|
|
|
|
|
|
|
1240
|
1169
|
|
|
|
|
2247
|
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
|
55821
|
my ($self, $depth) = @_; |
|
1283
|
|
|
|
|
|
|
### tree_depth_to_n(): "$depth parts=$self->{'parts'}" |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
7491
|
50
|
|
|
|
14364
|
if ($depth < 0) { |
|
1286
|
0
|
|
|
|
|
0
|
return undef; |
|
1287
|
|
|
|
|
|
|
} |
|
1288
|
7491
|
|
|
|
|
8212
|
$depth = int($depth); |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
7491
|
|
|
|
|
10486
|
my $parts = $self->{'parts'}; |
|
1291
|
|
|
|
|
|
|
{ |
|
1292
|
7491
|
|
|
|
|
9034
|
my $initial = $tree_depth_to_n{$parts}; |
|
|
7491
|
|
|
|
|
10529
|
|
|
1293
|
7491
|
100
|
|
|
|
17452
|
if ($depth <= $#$initial) { |
|
1294
|
123
|
|
|
|
|
319
|
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
|
|
|
|
|
10494
|
$depth += $parts_depth_adjust{$parts}; |
|
1306
|
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
# +1 for parts=3 using depth+1 |
|
1308
|
7368
|
|
|
|
|
19852
|
my ($pow,$exp) = round_down_pow ($depth+1, 2); |
|
1309
|
7368
|
50
|
|
|
|
75736
|
if (is_infinite($exp)) { |
|
1310
|
0
|
|
|
|
|
0
|
return $exp; |
|
1311
|
|
|
|
|
|
|
} |
|
1312
|
|
|
|
|
|
|
### $pow |
|
1313
|
|
|
|
|
|
|
### $exp |
|
1314
|
|
|
|
|
|
|
|
|
1315
|
7368
|
|
|
|
|
44398
|
my $zero = $depth*0; |
|
1316
|
7368
|
|
|
|
|
11933
|
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
|
|
|
|
|
7863
|
my @pending; |
|
1327
|
|
|
|
|
|
|
my @mult; |
|
1328
|
|
|
|
|
|
|
|
|
1329
|
7368
|
100
|
100
|
|
|
43775
|
if ($parts eq 'octant' || $parts eq 'octant_up') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
1330
|
883
|
|
|
|
|
1278
|
@pending = ($depth); |
|
1331
|
883
|
|
|
|
|
1524
|
@mult = (1+$zero); |
|
1332
|
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
} elsif ($parts eq 'wedge') { |
|
1334
|
|
|
|
|
|
|
# wedge(depth) = 2*oct(depth-1) + 4 |
|
1335
|
66
|
|
|
|
|
118
|
@pending = ($depth); |
|
1336
|
66
|
|
|
|
|
102
|
@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
|
|
|
|
|
56
|
$n -= 4*$depth - 16; # overlapping spines |
|
1346
|
40
|
|
|
|
|
68
|
@pending = ($depth,$depth-3); |
|
1347
|
40
|
|
|
|
|
76
|
@mult = ((4+$zero) x 2); |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
} elsif ($parts eq '3') { |
|
1350
|
1557
|
|
|
|
|
3177
|
@pending = ($depth+1, $depth, $depth-1); |
|
1351
|
1557
|
|
|
|
|
2744
|
@mult = (1+$zero, 3+$zero, 2+$zero); |
|
1352
|
1557
|
|
|
|
|
2206
|
$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
|
|
|
|
|
8903
|
@pending = ($depth, $depth-1); |
|
1359
|
4822
|
|
|
|
|
8463
|
@mult = ($parts + $zero) x 2; |
|
1360
|
4822
|
|
|
|
|
7632
|
$n -= $parts*($depth-3); |
|
1361
|
|
|
|
|
|
|
} |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
7368
|
|
|
|
|
15620
|
while (--$exp >= 0) { |
|
1364
|
25649
|
100
|
|
|
|
48153
|
last unless @pending; |
|
1365
|
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
### @pending |
|
1367
|
|
|
|
|
|
|
### @mult |
|
1368
|
|
|
|
|
|
|
### $exp |
|
1369
|
|
|
|
|
|
|
### $pow |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
22423
|
|
|
|
|
26759
|
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
|
|
|
|
|
31872
|
foreach my $depth (@pending) { |
|
1381
|
46603
|
|
|
|
|
53998
|
my $mult = shift @mult; |
|
1382
|
|
|
|
|
|
|
### assert: $depth >= 2 |
|
1383
|
|
|
|
|
|
|
### assert: $depth < 2*$pow |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
46603
|
100
|
|
|
|
86396
|
if ($depth <= 3) { |
|
1386
|
11148
|
100
|
|
|
|
23903
|
if ($depth eq '3') { |
|
1387
|
|
|
|
|
|
|
### depth==3 total=1 ... |
|
1388
|
6927
|
|
|
|
|
9079
|
$n += $mult; |
|
1389
|
|
|
|
|
|
|
} else { |
|
1390
|
|
|
|
|
|
|
### depth==2 total=0 ... |
|
1391
|
|
|
|
|
|
|
} |
|
1392
|
11148
|
|
|
|
|
17286
|
next; |
|
1393
|
|
|
|
|
|
|
} |
|
1394
|
|
|
|
|
|
|
|
|
1395
|
35455
|
100
|
|
|
|
68531
|
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
|
|
|
|
|
8346
|
push @new_pending, $depth; |
|
1400
|
6689
|
|
|
|
|
7786
|
push @new_mult, $mult; |
|
1401
|
6689
|
|
|
|
|
10112
|
next; |
|
1402
|
|
|
|
|
|
|
} |
|
1403
|
28766
|
|
|
|
|
37155
|
my $rem = $depth - $pow; |
|
1404
|
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
### $depth |
|
1406
|
|
|
|
|
|
|
### $mult |
|
1407
|
|
|
|
|
|
|
### $rem |
|
1408
|
|
|
|
|
|
|
### assert: $rem >= 0 && $rem < $pow |
|
1409
|
|
|
|
|
|
|
|
|
1410
|
28766
|
|
|
|
|
31205
|
my $basemult = $mult; # multiple of oct(2^k) base part |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
28766
|
100
|
|
|
|
60550
|
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
|
|
|
|
|
6971
|
$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
|
|
|
|
|
23305
|
$n += (4-$rem)*$mult; |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
18234
|
|
|
|
|
19858
|
$rem += 1; # to give rem+1 |
|
1425
|
18234
|
100
|
100
|
|
|
59727
|
if ($rem == $pow) { |
|
|
|
100
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
### rem+1==pow so oct(2^k) by increasing basemult ... |
|
1427
|
4927
|
|
|
|
|
5889
|
$basemult += $mult; |
|
1428
|
|
|
|
|
|
|
} elsif (@new_pending && $new_pending[-1] == $rem) { |
|
1429
|
|
|
|
|
|
|
### combine rem+1 here with rem of previous ... |
|
1430
|
6971
|
|
|
|
|
10264
|
$new_mult[-1] += $mult; |
|
1431
|
|
|
|
|
|
|
} else { |
|
1432
|
6336
|
|
|
|
|
8988
|
push @new_pending, $rem; |
|
1433
|
6336
|
|
|
|
|
8532
|
push @new_mult, $mult; |
|
1434
|
|
|
|
|
|
|
} |
|
1435
|
18234
|
50
|
|
|
|
38631
|
if ($rem -= 1) { # to give plain rem again |
|
1436
|
18234
|
|
|
|
|
22007
|
push @new_pending, $rem; |
|
1437
|
18234
|
|
|
|
|
28034
|
push @new_mult, 2*$mult; |
|
1438
|
|
|
|
|
|
|
} |
|
1439
|
|
|
|
|
|
|
} |
|
1440
|
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
# oct(2^k) = (4^(k-1) - 4)/3 + 2^(k-1) |
|
1442
|
28766
|
|
66
|
|
|
79361
|
$tpow ||= ($pow*$pow - 16)/12 + $pow/2; |
|
1443
|
28766
|
|
|
|
|
52993
|
$n += $basemult * $tpow; |
|
1444
|
|
|
|
|
|
|
} |
|
1445
|
22423
|
|
|
|
|
38482
|
@pending = @new_pending; |
|
1446
|
22423
|
|
|
|
|
33294
|
@mult = @new_mult; |
|
1447
|
22423
|
|
|
|
|
57220
|
$pow /= 2; |
|
1448
|
|
|
|
|
|
|
} |
|
1449
|
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
### return: $n |
|
1451
|
7368
|
|
|
|
|
16977
|
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
|
|
2844
|
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
|
|
|
|
|
3409
|
my ($pow,$exp) = round_down_pow ($depth_list->[0], 2); |
|
1485
|
1268
|
50
|
|
|
|
12868
|
if (is_infinite($exp)) { |
|
1486
|
0
|
|
|
|
|
0
|
return $exp; |
|
1487
|
|
|
|
|
|
|
} |
|
1488
|
|
|
|
|
|
|
### $pow |
|
1489
|
|
|
|
|
|
|
### $exp |
|
1490
|
|
|
|
|
|
|
|
|
1491
|
1268
|
|
|
|
|
7752
|
my $add = $zero; |
|
1492
|
|
|
|
|
|
|
|
|
1493
|
1268
|
|
|
|
|
2652
|
while (--$exp >= 0) { # running $pow down to 2 (inclusive) |
|
1494
|
|
|
|
|
|
|
### assert: $pow >= 2 |
|
1495
|
3695
|
100
|
|
|
|
7349
|
last unless @$depth_list; |
|
1496
|
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
### pending: join(',',@$depth_list) |
|
1498
|
|
|
|
|
|
|
### mult : join(',',@$mult_list) |
|
1499
|
|
|
|
|
|
|
### $exp |
|
1500
|
|
|
|
|
|
|
### $pow |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
3227
|
|
|
|
|
3503
|
my @new_depth_list; |
|
1503
|
|
|
|
|
|
|
my @new_mult_list; |
|
1504
|
|
|
|
|
|
|
|
|
1505
|
3227
|
|
|
|
|
4661
|
foreach my $depth (@$depth_list) { |
|
1506
|
6463
|
|
|
|
|
7867
|
my $mult = shift @$mult_list; |
|
1507
|
|
|
|
|
|
|
### assert: $depth >= 0 |
|
1508
|
|
|
|
|
|
|
### assert: $depth == int($depth) |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
6463
|
100
|
|
|
|
13083
|
if ($depth <= 3) { |
|
1511
|
|
|
|
|
|
|
### depth==2or3 add=1 ... |
|
1512
|
2334
|
|
|
|
|
2459
|
$add += $mult; |
|
1513
|
2334
|
|
|
|
|
3648
|
next; |
|
1514
|
|
|
|
|
|
|
} |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
4129
|
100
|
|
|
|
8242
|
if ($depth < $pow) { |
|
1517
|
|
|
|
|
|
|
# less than 2^exp so unchanged |
|
1518
|
1077
|
|
|
|
|
1434
|
push @new_depth_list, $depth; |
|
1519
|
1077
|
|
|
|
|
1234
|
push @new_mult_list, $mult; |
|
1520
|
1077
|
|
|
|
|
1626
|
next; |
|
1521
|
|
|
|
|
|
|
} |
|
1522
|
|
|
|
|
|
|
|
|
1523
|
3052
|
|
|
|
|
3725
|
my $rem = $depth - $pow; |
|
1524
|
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
### $depth |
|
1526
|
|
|
|
|
|
|
### $mult |
|
1527
|
|
|
|
|
|
|
### $rem |
|
1528
|
|
|
|
|
|
|
### assert: $rem >= 0 && $rem <= $pow |
|
1529
|
|
|
|
|
|
|
|
|
1530
|
3052
|
100
|
100
|
|
|
11165
|
if ($rem == 0 || $rem == $pow-1) { |
|
1531
|
|
|
|
|
|
|
### rem==0, A of each, add=1 ... |
|
1532
|
|
|
|
|
|
|
### or depth=2*pow-1, add=1 ... |
|
1533
|
802
|
|
|
|
|
1410
|
$add += $mult; |
|
1534
|
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
} else { |
|
1536
|
|
|
|
|
|
|
### rem >= 2, formula ... |
|
1537
|
|
|
|
|
|
|
# A(pow+rem) = A(rem+1) + 2A(rem) - 1 |
|
1538
|
2250
|
|
|
|
|
2501
|
$add -= $mult; |
|
1539
|
|
|
|
|
|
|
|
|
1540
|
2250
|
|
|
|
|
2728
|
$rem += 1; # to make rem+1 |
|
1541
|
2250
|
100
|
100
|
|
|
6623
|
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
|
|
|
|
|
914
|
$new_mult_list[-1] += $mult; |
|
1545
|
|
|
|
|
|
|
} else { |
|
1546
|
1527
|
|
|
|
|
2269
|
push @new_depth_list, $rem; |
|
1547
|
1527
|
|
|
|
|
2237
|
push @new_mult_list, $mult; |
|
1548
|
|
|
|
|
|
|
} |
|
1549
|
2250
|
|
|
|
|
3502
|
push @new_depth_list, $rem-1; # back to plain rem |
|
1550
|
2250
|
|
|
|
|
4381
|
push @new_mult_list, 2*$mult; |
|
1551
|
|
|
|
|
|
|
} |
|
1552
|
|
|
|
|
|
|
} |
|
1553
|
3227
|
|
|
|
|
4471
|
$depth_list = \@new_depth_list; |
|
1554
|
3227
|
|
|
|
|
4643
|
$mult_list = \@new_mult_list; |
|
1555
|
3227
|
|
|
|
|
8794
|
$pow /= 2; |
|
1556
|
|
|
|
|
|
|
} |
|
1557
|
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
### return: $add |
|
1559
|
1268
|
|
|
|
|
2690
|
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
|
2988
|
my ($self, $level) = @_; |
|
1761
|
|
|
|
|
|
|
return (0, |
|
1762
|
|
|
|
|
|
|
$self->tree_depth_to_n_end(2**($level+2) |
|
1763
|
52
|
|
|
|
|
226
|
- $level_depth_offset{$self->{'parts'}})); |
|
1764
|
|
|
|
|
|
|
} |
|
1765
|
|
|
|
|
|
|
sub n_to_level { |
|
1766
|
44
|
|
|
44
|
1
|
12181
|
my ($self, $n) = @_; |
|
1767
|
44
|
|
|
|
|
115
|
my $depth = $self->tree_n_to_depth($n); |
|
1768
|
44
|
50
|
|
|
|
97
|
if (! defined $depth) { return undef; } |
|
|
0
|
|
|
|
|
0
|
|
|
1769
|
|
|
|
|
|
|
my ($pow, $exp) = round_down_pow |
|
1770
|
44
|
|
|
|
|
159
|
($depth + $level_depth_offset{$self->{'parts'}} - 1, |
|
1771
|
|
|
|
|
|
|
2); |
|
1772
|
44
|
|
|
|
|
514
|
return max(0, $exp - 1); |
|
1773
|
|
|
|
|
|
|
} |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
1776
|
|
|
|
|
|
|
1; |
|
1777
|
|
|
|
|
|
|
__END__ |