File Coverage

blib/lib/Math/PlanePath/KochelCurve.pm
Criterion Covered Total %
statement 52 113 46.0
branch 4 60 6.6
condition 0 10 0.0
subroutine 12 14 85.7
pod 3 3 100.0
total 71 200 35.5


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             package Math::PlanePath::KochelCurve;
20 1     1   13213 use 5.004;
  1         8  
21 1     1   4 use strict;
  1         2  
  1         48  
22             #use List::Util 'max';
23             *max = \&Math::PlanePath::_max;
24              
25 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         57  
26             $VERSION = 128;
27 1     1   585 use Math::PlanePath;
  1         3  
  1         26  
28 1     1   540 use Math::PlanePath::Base::NSEW;
  1         2  
  1         33  
29             @ISA = ('Math::PlanePath::Base::NSEW',
30             'Math::PlanePath');
31              
32             use Math::PlanePath::Base::Generic
33 1         38 'is_infinite',
34 1     1   5 'round_nearest';
  1         2  
35             use Math::PlanePath::Base::Digits
36 1         55 'round_down_pow',
37             'digit_split_lowtohigh',
38 1     1   387 'digit_join_lowtohigh';
  1         2  
39              
40              
41             # uncomment this to run the ### lines
42             #use Smart::Comments;
43              
44              
45 1     1   6 use constant n_start => 0;
  1         1  
  1         37  
46 1     1   5 use constant class_x_negative => 0;
  1         1  
  1         31  
47 1     1   4 use constant class_y_negative => 0;
  1         16  
  1         1269  
48             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
49              
50              
51             #------------------------------------------------------------------------------
52              
53             # tables generated by tools/kochel-curve-table.pl
54             #
55             my @next_state = (63,72, 9, 99, 0,90, 36,99, 0, # 0
56             36,81,18, 72, 9,99, 45,72, 9, # 9
57             45,90,27, 81,18,72, 54,81,18, # 18
58             54,99, 0, 90,27,81, 63,90,27, # 27
59             36,81, 0, 72,36,81, 45,90,27, # 36
60             45,90, 9, 81,45,90, 54,99, 0, # 45
61             54,99,18, 90,54,99, 63,72, 9, # 54
62             63,72,27, 99,63,72, 36,81,18, # 63
63             63,72, 9, 99,90,99, 63,72, 9, # 72
64             36,81,18, 72,99,72, 36,81,18, # 81
65             45,90,27, 81,72,81, 45,90,27, # 90
66             54,99, 0, 90,81,90, 54,99, 0); # 99
67             my @digit_to_x = (0,0,0, 1,2,2, 1,1,2, # 0
68             2,1,0, 0,0,1, 1,2,2, # 9
69             2,2,2, 1,0,0, 1,1,0, # 18
70             0,1,2, 2,2,1, 1,0,0, # 27
71             2,1,1, 2,2,1, 0,0,0, # 36
72             2,2,1, 1,0,0, 0,1,2, # 45
73             0,1,1, 0,0,1, 2,2,2, # 54
74             0,0,1, 1,2,2, 2,1,0, # 63
75             0,0,0, 1,1,1, 2,2,2, # 72
76             2,1,0, 0,1,2, 2,1,0, # 81
77             2,2,2, 1,1,1, 0,0,0, # 90
78             0,1,2, 2,1,0, 0,1,2); # 99
79             my @digit_to_y = (0,1,2, 2,2,1, 1,0,0, # 0
80             0,0,0, 1,2,2, 1,1,2, # 9
81             2,1,0, 0,0,1, 1,2,2, # 18
82             2,2,2, 1,0,0, 1,1,0, # 27
83             0,0,1, 1,2,2, 2,1,0, # 36
84             2,1,1, 2,2,1, 0,0,0, # 45
85             2,2,1, 1,0,0, 0,1,2, # 54
86             0,1,1, 0,0,1, 2,2,2, # 63
87             0,1,2, 2,1,0, 0,1,2, # 72
88             0,0,0, 1,1,1, 2,2,2, # 81
89             2,1,0, 0,1,2, 2,1,0, # 90
90             2,2,2, 1,1,1, 0,0,0); # 99
91             my @xy_to_digit = (0,1,2, 7,6,3, 8,5,4, # 0
92             2,3,4, 1,6,5, 0,7,8, # 9
93             4,5,8, 3,6,7, 2,1,0, # 18
94             8,7,0, 5,6,1, 4,3,2, # 27
95             8,7,6, 1,2,5, 0,3,4, # 36
96             6,5,4, 7,2,3, 8,1,0, # 45
97             4,3,0, 5,2,1, 6,7,8, # 54
98             0,1,8, 3,2,7, 4,5,6, # 63
99             0,1,2, 5,4,3, 6,7,8, # 72
100             2,3,8, 1,4,7, 0,5,6, # 81
101             8,7,6, 3,4,5, 2,1,0, # 90
102             6,5,0, 7,4,1, 8,3,2); # 99
103             my @min_digit = (0,0,0,7,8,7, # 0
104             0,0,0,5,5,6,
105             0,0,0,3,4,3,
106             1,1,1,3,4,3,
107             2,2,2,3,4,3,
108             1,1,1,5,5,6,
109             2,1,0,0,0,1, # 36
110             2,1,0,0,0,1,
111             2,1,0,0,0,1,
112             3,3,3,5,7,5,
113             4,4,4,5,8,5,
114             3,3,3,6,7,6,
115             4,3,2,2,2,3, # 72
116             4,3,1,1,1,3,
117             4,3,0,0,0,3,
118             5,5,0,0,0,6,
119             8,7,0,0,0,7,
120             5,5,1,1,1,6,
121             8,5,4,4,4,5, # 108
122             7,5,3,3,3,5,
123             0,0,0,1,2,1,
124             0,0,0,1,2,1,
125             0,0,0,1,2,1,
126             7,6,3,3,3,6,
127             8,1,0,0,0,1, # 144
128             7,1,0,0,0,1,
129             6,1,0,0,0,1,
130             6,2,2,2,3,2,
131             6,5,4,4,4,5,
132             7,2,2,2,3,2,
133             6,6,6,7,8,7, # 180
134             5,2,1,1,1,2,
135             4,2,0,0,0,2,
136             4,2,0,0,0,2,
137             4,3,0,0,0,3,
138             5,2,1,1,1,2,
139             4,4,4,5,6,5, # 216
140             3,2,2,2,6,2,
141             0,0,0,1,6,1,
142             0,0,0,1,7,1,
143             0,0,0,1,8,1,
144             3,2,2,2,7,2,
145             0,0,0,3,4,3, # 252
146             0,0,0,2,4,2,
147             0,0,0,2,4,2,
148             1,1,1,2,5,2,
149             8,7,6,6,6,7,
150             1,1,1,2,5,2,
151             0,0,0,5,6,5, # 288
152             0,0,0,4,6,4,
153             0,0,0,3,6,3,
154             1,1,1,3,7,3,
155             2,2,2,3,8,3,
156             1,1,1,4,7,4,
157             2,1,0,0,0,1, # 324
158             2,1,0,0,0,1,
159             2,1,0,0,0,1,
160             3,3,3,4,5,4,
161             8,7,6,6,6,7,
162             3,3,3,4,5,4,
163             8,3,2,2,2,3, # 360
164             7,3,1,1,1,3,
165             6,3,0,0,0,3,
166             6,4,0,0,0,4,
167             6,5,0,0,0,5,
168             7,4,1,1,1,4,
169             6,6,6,7,8,7, # 396
170             5,4,3,3,3,4,
171             0,0,0,1,2,1,
172             0,0,0,1,2,1,
173             0,0,0,1,2,1,
174             5,4,3,3,3,4);
175             my @max_digit = (0,7,8,8,8,7, # 0
176             1,7,8,8,8,7,
177             2,7,8,8,8,7,
178             2,6,6,6,5,6,
179             2,3,4,4,4,3,
180             1,6,6,6,5,6,
181             2,2,2,1,0,1, # 36
182             3,6,7,7,7,6,
183             4,6,8,8,8,6,
184             4,6,8,8,8,6,
185             4,5,8,8,8,5,
186             3,6,7,7,7,6,
187             4,4,4,3,2,3, # 72
188             5,6,6,6,2,6,
189             8,8,8,7,2,7,
190             8,8,8,7,1,7,
191             8,8,8,7,0,7,
192             5,6,6,6,1,6,
193             8,8,8,5,4,5, # 108
194             8,8,8,6,4,6,
195             8,8,8,6,4,6,
196             7,7,7,6,3,6,
197             0,1,2,2,2,1,
198             7,7,7,6,3,6,
199             8,8,8,1,0,1, # 144
200             8,8,8,3,3,2,
201             8,8,8,5,4,5,
202             7,7,7,5,4,5,
203             6,6,6,5,4,5,
204             7,7,7,3,3,2,
205             6,7,8,8,8,7, # 180
206             6,7,8,8,8,7,
207             6,7,8,8,8,7,
208             5,5,5,3,1,3,
209             4,4,4,3,0,3,
210             5,5,5,2,1,2,
211             4,5,6,6,6,5, # 216
212             4,5,7,7,7,5,
213             4,5,8,8,8,5,
214             3,3,8,8,8,2,
215             0,1,8,8,8,1,
216             3,3,7,7,7,2,
217             0,3,4,4,4,3, # 252
218             1,3,5,5,5,3,
219             8,8,8,7,6,7,
220             8,8,8,7,6,7,
221             8,8,8,7,6,7,
222             1,2,5,5,5,2,
223             0,5,6,6,6,5, # 288
224             1,5,7,7,7,5,
225             2,5,8,8,8,5,
226             2,4,8,8,8,4,
227             2,3,8,8,8,3,
228             1,4,7,7,7,4,
229             2,2,2,1,0,1, # 324
230             3,4,5,5,5,4,
231             8,8,8,7,6,7,
232             8,8,8,7,6,7,
233             8,8,8,7,6,7,
234             3,4,5,5,5,4,
235             8,8,8,3,2,3, # 360
236             8,8,8,4,2,4,
237             8,8,8,5,2,5,
238             7,7,7,5,1,5,
239             6,6,6,5,0,5,
240             7,7,7,4,1,4,
241             6,7,8,8,8,7, # 396
242             6,7,8,8,8,7,
243             6,7,8,8,8,7,
244             5,5,5,4,3,4,
245             0,1,2,2,2,1,
246             5,5,5,4,3,4);
247             # state length 108 in each of 4 tables
248              
249             sub n_to_xy {
250 2161     2161 1 29554 my ($self, $n) = @_;
251             ### KochelCurve n_to_xy(): $n
252              
253 2161 50       3551 if ($n < 0) { return; }
  0         0  
254 2161 50       3343 if (is_infinite($n)) { return ($n,$n); }
  0         0  
255              
256 2161         3182 my $int = int($n);
257 2161         2423 $n -= $int; # remaining fraction, preserve possible BigFloat/BigRat
258              
259 2161         3273 my @digits = digit_split_lowtohigh($int,9);
260 2161         3098 my $len = ($int*0 + 3) ** scalar(@digits); # inherit bignum
261              
262             ### digits: join(', ',@digits)." count ".scalar(@digits)
263             ### $len
264              
265 2161         2353 my $state = 63;
266 2161         2305 my $dir = 1; # default if all $digit==8
267 2161         2203 my $x = 0;
268 2161         2207 my $y = 0;
269              
270 2161         3091 while (@digits) {
271 6934         7521 $len /= 3;
272 6934         7826 $state += (my $digit = pop @digits);
273 6934 100       9134 if ($digit != 8) {
274 6278         6549 $dir = $state; # lowest non-8 digit
275             }
276              
277             ### $len
278             ### $state
279             ### digit_to_x: $digit_to_x[$state]
280             ### digit_to_y: $digit_to_y[$state]
281             ### next_state: $next_state[$state]
282              
283 6934         7847 $x += $len * $digit_to_x[$state];
284 6934         7347 $y += $len * $digit_to_y[$state];
285 6934         9981 $state = $next_state[$state];
286             }
287              
288             ### $dir
289             ### frac: $n
290              
291             # with $n fractional part
292 2161         5446 return ($n * ($digit_to_x[$dir+1] - $digit_to_x[$dir]) + $x,
293             $n * ($digit_to_y[$dir+1] - $digit_to_y[$dir]) + $y);
294             }
295              
296             sub xy_to_n {
297 0     0 1   my ($self, $x, $y) = @_;
298             ### KochelCurve xy_to_n(): "$x, $y"
299              
300 0           $x = round_nearest ($x);
301 0           $y = round_nearest ($y);
302 0 0 0       if ($x < 0 || $y < 0) {
303 0           return undef;
304             }
305 0 0         if (is_infinite($x)) {
306 0           return $x;
307             }
308 0 0         if (is_infinite($y)) {
309 0           return $y;
310             }
311              
312 0           my @xdigits = digit_split_lowtohigh ($x, 3);
313 0           my @ydigits = digit_split_lowtohigh ($y, 3);
314 0           my $state = 63;
315 0           my @ndigits;
316 0           foreach my $i (reverse 0 .. max($#xdigits,$#ydigits)) { # high to low
317 0   0       my $ndigit = $xy_to_digit[$state
      0        
318             + 3*($xdigits[$i]||0)
319             + ($ydigits[$i]||0)];
320 0           $ndigits[$i] = $ndigit;
321 0           $state = $next_state[$state+$ndigit];
322             }
323              
324 0           return digit_join_lowtohigh (\@ndigits, 9,
325             $x * 0 * $y); # bignum zero
326             }
327              
328             # exact
329             sub rect_to_n_range {
330 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
331             ### KochelCurve rect_to_n_range(): "$x1,$y1, $x2,$y2"
332              
333 0           $x1 = round_nearest ($x1);
334 0           $x2 = round_nearest ($x2);
335 0           $y1 = round_nearest ($y1);
336 0           $y2 = round_nearest ($y2);
337 0 0         ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
338 0 0         ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
339              
340 0 0 0       if ($x2 < 0 || $y2 < 0) {
341 0           return (1, 0);
342             }
343              
344 0           my ($len, $level) = round_down_pow (max($x2,$y2), 3);
345             ### $len
346             ### $level
347 0 0         if (is_infinite($level)) {
348 0           return (0, $level);
349             }
350              
351             # At this point an easy round-up range here would be:
352             # return (0, 9*$len*$len-1);
353              
354              
355 0           my $n_min = my $n_max
356             = my $x_min = my $y_min
357             = my $x_max = my $y_max
358             = ($x1 * 0 * $x2 * $y1 * $y2); # inherit bignum 0
359              
360 0           my $min_state = my $max_state = 63;
361              
362             # x__ 0
363             # xx_ 1
364             # xxx 2
365             # _xx 3
366             # __x 4
367             # _x_ 5
368             #
369 0           while ($level >= 0) {
370 0           my $l2 = 2*$len;
371             {
372 0           my $x_cmp1 = $x_min + $len;
373 0           my $y_cmp1 = $y_min + $len;
374 0           my $x_cmp2 = $x_min + $l2;
375 0           my $y_cmp2 = $y_min + $l2;
376 0 0         my $digit = $min_digit[4*$min_state # 4*9=36 apart
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
377             + ($x1 >= $x_cmp2 ? 4
378             : $x1 >= $x_cmp1 ? ($x2 < $x_cmp2 ? 5 : 3)
379             : ($x2 < $x_cmp1 ? 0
380             : $x2 < $x_cmp2 ? 1 : 2))
381             + ($y1 >= $y_cmp2 ? 6*4
382             : $y1 >= $y_cmp1 ? ($y2 < $y_cmp2 ? 6*5 : 6*3)
383             : ($y2 < $y_cmp1 ? 6*0
384             : $y2 < $y_cmp2 ? 6*1 : 6*2))];
385              
386             # my $key = 4*$min_state # 4*9=36 apart
387             # + ($x1 >= $x_cmp2 ? 4
388             # : $x1 >= $x_cmp1 ? ($x2 < $x_cmp2 ? 5 : 3)
389             # : ($x2 < $x_cmp1 ? 0
390             # : $x2 < $x_cmp2 ? 1 : 2))
391             # + ($y1 >= $y_cmp2 ? 6*4
392             # : $y1 >= $y_cmp1 ? ($y2 < $y_cmp2 ? 6*5 : 6*3)
393             # : ($y2 < $y_cmp1 ? 6*0
394             # : $y2 < $y_cmp2 ? 6*1 : 6*2));
395             # ### $min_state
396             # ### $len
397             # ### $l2
398             # ### $key
399             # ### $x_cmp1
400             # ### $x_cmp2
401             # ### $digit
402              
403              
404 0           $n_min = 9*$n_min + $digit;
405 0           $min_state += $digit;
406 0           $x_min += $len * $digit_to_x[$min_state];
407 0           $y_min += $len * $digit_to_y[$min_state];
408 0           $min_state = $next_state[$min_state];
409             }
410             {
411 0           my $x_cmp1 = $x_max + $len;
  0            
  0            
412 0           my $y_cmp1 = $y_max + $len;
413 0           my $x_cmp2 = $x_max + $l2;
414 0           my $y_cmp2 = $y_max + $l2;
415 0 0         my $digit = $max_digit[4*$max_state # 4*9=36 apart
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
416             + ($x1 >= $x_cmp2 ? 4
417             : $x1 >= $x_cmp1 ? ($x2 < $x_cmp2 ? 5 : 3)
418             : ($x2 < $x_cmp1 ? 0
419             : $x2 < $x_cmp2 ? 1 : 2))
420             + ($y1 >= $y_cmp2 ? 6*4
421             : $y1 >= $y_cmp1 ? ($y2 < $y_cmp2 ? 6*5 : 6*3)
422             : ($y2 < $y_cmp1 ? 6*0
423             : $y2 < $y_cmp2 ? 6*1 : 6*2))];
424              
425             # my $key = 4*$max_state # 4*9=36 apart
426             # + ($x1 >= $x_cmp2 ? 4
427             # : $x1 >= $x_cmp1 ? ($x2 < $x_cmp2 ? 5 : 3)
428             # : ($x2 < $x_cmp1 ? 0
429             # : $x2 < $x_cmp2 ? 1 : 2))
430             # + ($y1 >= $y_cmp2 ? 4
431             # : $y1 >= $y_cmp1 ? ($y2 < $y_cmp2 ? 5 : 3)
432             # : ($y2 < $y_cmp1 ? 0
433             # : $y2 < $y_cmp2 ? 1 : 2));
434             # ### $max_state
435             # ### $len
436             # ### $l2
437             # ### $x_key
438             # ### $key
439             # ### $x_max
440             # ### $y_max
441             # ### $x_cmp1
442             # ### $x_cmp2
443             # ### $y_cmp1
444             # ### $y_cmp2
445             # ### $digit
446             # ### max digit: $max_digit[$key]
447              
448 0           $n_max = 9*$n_max + $digit;
449 0           $max_state += $digit;
450 0           $x_max += $len * $digit_to_x[$max_state];
451 0           $y_max += $len * $digit_to_y[$max_state];
452 0           $max_state = $next_state[$max_state];
453             }
454              
455 0           $len = int($len/3);
456 0           $level--;
457             }
458 0           return ($n_min, $n_max);
459             }
460              
461             #-----------------------------------------------------------------------------
462             # level_to_n_range()
463              
464 1     1   411 use Math::PlanePath::SquareReplicate;
  1         3  
  1         94  
465             *level_to_n_range = \&Math::PlanePath::SquareReplicate::level_to_n_range;
466             *n_to_level = \&Math::PlanePath::SquareReplicate::n_to_level;
467              
468             #-----------------------------------------------------------------------------
469             1;
470             __END__