File Coverage

blib/lib/Math/PlanePath/HIndexing.pm
Criterion Covered Total %
statement 141 168 83.9
branch 38 54 70.3
condition 6 14 42.8
subroutine 15 20 75.0
pod 5 5 100.0
total 205 261 78.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             # http://theinf1.informatik.uni-jena.de/~niedermr/publications.html
20             #
21             # Rolf Niedermeier
22             # http://fpt.akt.tu-berlin.de/niedermr/publications.html
23             #
24             #
25             # H second part down per paper
26             # |
27             # | *--* * *-
28             # | | | | |
29             # | * *--* *
30             # | | |
31             # | * *--* *
32             # | | | | |
33             # | O * *--*
34             # |
35             # +------------
36             #
37             # eight similar to AlternatePaper
38             #
39             # |
40             # *--* *--* * *-
41             # | | | | | |
42             # --* * * *--* *--*
43             # | | |
44             # * * *--*--*--*
45             # | | |
46             # *--* * O *--*--*--*
47             # | |
48             # *--*--*--* * * *--*
49             # | | |
50             # *--*--*--* * * *-
51             # | | |
52             # *--* *--* * * *-
53             # | | | | | |
54             # *--* *--*
55             #
56              
57             package Math::PlanePath::HIndexing;
58 1     1   7700 use 5.004;
  1         7  
59 1     1   4 use strict;
  1         2  
  1         30  
60              
61 1     1   5 use vars '$VERSION', '@ISA';
  1         1  
  1         53  
62             $VERSION = 128;
63              
64 1     1   578 use Math::PlanePath;
  1         2  
  1         24  
65 1     1   350 use Math::PlanePath::Base::NSEW;
  1         2  
  1         34  
66             @ISA = ('Math::PlanePath::Base::NSEW',
67             'Math::PlanePath');
68              
69             use Math::PlanePath::Base::Generic
70 1         38 'is_infinite',
71 1     1   5 'round_nearest';
  1         1  
72             use Math::PlanePath::Base::Digits
73 1         63 'round_down_pow',
74             'round_up_pow',
75 1     1   367 'digit_split_lowtohigh';
  1         2  
76             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
77              
78              
79 1     1   6 use constant n_start => 0;
  1         2  
  1         39  
80 1     1   5 use constant class_x_negative => 0;
  1         1  
  1         33  
81 1     1   4 use constant class_y_negative => 0;
  1         1  
  1         31  
82 1     1   3 use constant diffxy_maximum => 0; # upper octant X<=Y so X-Y<=0
  1         2  
  1         48  
83 1     1   5 use constant 1.02 _UNDOCUMENTED__dxdy_list_at_n => 9;
  1         10  
  1         912  
84              
85              
86             #------------------------------------------------------------------------------
87              
88             sub n_to_xy {
89 278     278 1 12219 my ($self, $n) = @_;
90             ### HIndexing n_to_xy(): $n
91              
92 278 50       480 if ($n < 0) { # negative
93 0         0 return;
94             }
95 278 50       493 if (is_infinite($n)) {
96 0         0 return ($n,$n);
97             }
98              
99             {
100             # ENHANCE-ME: get direction without full N+1 calculation
101 278         421 my $int = int($n);
  278         347  
102             ### $int
103             ### $n
104 278 100       436 if ($n != $int) {
105 60         101 my ($x1,$y1) = $self->n_to_xy($int);
106 60         114 my ($x2,$y2) = $self->n_to_xy($int+1);
107 60         82 my $frac = $n - $int; # inherit possible BigFloat
108 60         67 my $dx = $x2-$x1;
109 60         67 my $dy = $y2-$y1;
110 60         164 return ($frac*$dx + $x1, $frac*$dy + $y1);
111             }
112 218         256 $n = $int; # BigFloat int() gives BigInt, use that
113             }
114              
115 218         369 my $low = _divrem_mutate ($n, 2);
116             ### $low
117             ### $n
118              
119 218         386 my @digits = digit_split_lowtohigh($n,4);
120 218         349 my $len = ($n*0 + 2) ** scalar(@digits); # inherit bignum 2
121              
122 218         244 my $x = 0;
123 218         247 my $y = 0;
124 218         243 my $rev = 0;
125 218         218 my $xinvert = 0;
126 218         225 my $yinvert = 0;
127 218         334 while (@digits) {
128 687         774 my $digit = pop @digits;
129              
130             ### $len
131             ### $rev
132             ### $digit
133              
134 687         746 my $new_xinvert = $xinvert;
135 687         679 my $new_yinvert = $yinvert;
136 687         687 my $xo = 0;
137 687         1056 my $yo = 0;
138 687 100       866 if ($rev) {
139 219 100       360 if ($digit == 1) {
    100          
    100          
140 59         66 $xo = $len-1;
141 59         71 $yo = $len-1;
142 59         67 $rev ^= 1;
143 59         66 $new_yinvert = $yinvert ^ 1;
144             } elsif ($digit == 2) {
145 53         65 $xo = 2*$len-2;
146 53         69 $yo = 0;
147 53         61 $rev ^= 1;
148 53         57 $new_xinvert = $xinvert ^ 1;
149             } elsif ($digit == 3) {
150 56         60 $xo = $len;
151 56         59 $yo = $len;
152             }
153              
154             } else {
155 468 100       807 if ($digit == 1) {
    100          
    100          
156 142         167 $xo = $len-2;
157 142         164 $yo = $len;
158 142         173 $rev ^= 1;
159 142         159 $new_xinvert = $xinvert ^ 1;
160             } elsif ($digit == 2) {
161 92         93 $xo = 1;
162 92         119 $yo = 2*$len-1;
163 92         127 $rev ^= 1;
164 92         109 $new_yinvert = $yinvert ^ 1;
165             } elsif ($digit == 3) {
166 151         166 $xo = $len;
167 151         158 $yo = $len;
168             }
169             }
170              
171             ### $xo
172             ### $yo
173              
174 687 100       831 if ($xinvert) {
175 211         248 $x -= $xo;
176             } else {
177 476         514 $x += $xo;
178             }
179 687 100       790 if ($yinvert) {
180 168         173 $y -= $yo;
181             } else {
182 519         533 $y += $yo;
183             }
184              
185 687         725 $xinvert = $new_xinvert;
186 687         693 $yinvert = $new_yinvert;
187 687         1039 $len /= 2;
188             }
189              
190             ### final: "$x,$y"
191              
192 218 100       308 if ($yinvert) {
193 63         76 $y -= $low;
194             } else {
195 155         178 $y += $low;
196             }
197              
198             ### is: "$x,$y"
199 218         376 return ($x, $y);
200             }
201              
202             # uncomment this to run the ### lines
203             #use Smart::Comments;
204              
205             sub xy_to_n {
206 186     186 1 11474 my ($self, $x, $y) = @_;
207             ### HIndexing xy_to_n(): "$x, $y"
208              
209 186         398 $x = round_nearest ($x);
210 186         294 $y = round_nearest ($y);
211              
212 186 50 33     784 if ($x < 0 || $y < 0 || $x > $y - ($y&1)) {
      33        
213 0         0 return undef;
214             }
215 186 50       327 if (is_infinite($x)) {
216 0         0 return $x;
217             }
218 186         506 my ($len, $level) = round_down_pow (int($y/1), 2);
219             ### $len
220             ### $level
221 186 50       315 if (is_infinite($level)) {
222 0         0 return $level;
223             }
224              
225 186         253 my $n = 0;
226 186         250 my $npower = $len*$len/2;
227 186         203 my $rev = 0;
228 186         306 while (--$level >= 0) {
229             ### at: "$x,$y rev=$rev len=$len n=$n"
230 992         974 my $digit;
231 992         1034 my $new_rev = $rev;
232 992 100       1278 if ($y >= $len) {
233 628         650 $y -= $len;
234 628 100       756 if ($x >= $len) {
235             ### digit 3 ...
236 498         548 $digit = 3;
237 498         560 $x -= $len;
238             } else {
239 130         139 my $yinv = $len-1-$y;
240             ### digit 1 or 2: "y reduce to $y, x cmp ".($yinv-($yinv&1))
241 130 100       180 if ($x > $yinv-($yinv&1)) {
242             ### digit 2, x invert to: $len-1-$x
243 59         61 $digit = 2;
244 59         68 $x = $len-1-$x;
245             } else {
246             ### digit 1, y invert to: $yinv
247 71         72 $digit = 1;
248 71         78 $y = $yinv;
249             }
250 130         140 $new_rev ^= 1;
251             }
252             } else {
253             ### digit 0 ...
254 364         376 $digit = 0;
255             }
256              
257 992 100       1306 if ($rev) {
258 95         99 $digit = 3 - $digit;
259             ### reversed digit: $digit
260             }
261 992         1043 $rev = $new_rev;
262              
263             ### add n: $npower*$digit
264 992         1082 $n += $npower*$digit;
265 992         1008 $len /= 2;
266 992         1409 $npower /= 4;
267             }
268              
269             ### end at: "$x,$y n=$n rev=$rev"
270             ### assert: $x == 0
271             ### assert: $y == 0 || $y == 1
272              
273 186         344 return $n + $y^$rev;
274             }
275              
276             # not exact
277             sub rect_to_n_range {
278 67     67 1 4454 my ($self, $x1,$y1, $x2,$y2) = @_;
279              
280 67         140 $x1 = round_nearest ($x1);
281 67         97 $y1 = round_nearest ($y1);
282 67         107 $x2 = round_nearest ($x2);
283 67         107 $y2 = round_nearest ($y2);
284 67 50       138 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
285 67 50       106 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
286             ### HIndexing rect_to_n_range(): "$x1,$y1 to $x2,$y2"
287              
288             # y2 & 1 excluding the X=Y diagonal on odd Y rows
289 67 50 33     271 if ($x2 < 0 || $y2 < 0 || $x1 > $y2 - ($y2&1)) {
      33        
290 0         0 return (1, 0);
291             }
292              
293 67   100     163 my ($len, $level) = round_down_pow (($y2||1), 2);
294 67         134 return (0, 2*$len*$len-1);
295             }
296              
297              
298             #------------------------------------------------------------------------------
299              
300             sub level_to_n_range {
301 0     0 1   my ($self, $level) = @_;
302 0           return (0, 2*4**$level - 1);
303             }
304             sub n_to_level {
305 0     0 1   my ($self, $n) = @_;
306 0 0         if ($n < 0) { return undef; }
  0            
307 0 0         if (is_infinite($n)) { return $n; }
  0            
308 0           $n = round_nearest($n);
309 0           _divrem_mutate ($n, 2);
310 0           my ($pow,$exp) = round_up_pow ($n+1, 4);
311 0           return $exp;
312             }
313              
314             sub _UNDOCUMENTED__level_to_area {
315 0     0     my ($self, $level) = @_;
316 0           return (2**$level - 1)**2;
317             }
318             sub _UNDOCUMENTED__level_to_area_Y {
319 0     0     my ($self, $level) = @_;
320 0 0         if ($level == 0) { return 0; }
  0            
321 0           return 2**(2*$level-1) - 2**$level;
322             }
323             sub _UNDOCUMENTED__level_to_area_up {
324 0     0     my ($self, $level) = @_;
325 0 0         if ($level == 0) { return 0; }
  0            
326 0           return 2**(2*$level-1) - 2**$level + 1;
327             }
328              
329             #------------------------------------------------------------------------------
330             1;
331             __END__