File Coverage

blib/lib/Math/PlanePath/DekkingCentres.pm
Criterion Covered Total %
statement 56 113 49.5
branch 0 18 0.0
condition 0 10 0.0
subroutine 19 24 79.1
pod 5 5 100.0
total 80 170 47.0


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 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::DekkingCentres;
20 2     2   35 use 5.004;
  2         7  
21 2     2   10 use strict;
  2         3  
  2         73  
22             #use List::Util 'max';
23             *max = \&Math::PlanePath::_max;
24              
25 2     2   10 use vars '$VERSION', '@ISA';
  2         4  
  2         133  
26             $VERSION = 128;
27 2     2   14 use Math::PlanePath;
  2         4  
  2         89  
28             @ISA = ('Math::PlanePath');
29              
30             use Math::PlanePath::Base::Generic
31 2         117 'is_infinite',
32 2     2   14 'round_nearest';
  2         3  
33             use Math::PlanePath::Base::Digits
34 2         101 'round_down_pow',
35             'round_up_pow',
36             'digit_split_lowtohigh',
37 2     2   13 'digit_join_lowtohigh';
  2         3  
38              
39             # uncomment this to run the ### lines
40             #use Smart::Comments;
41              
42              
43 2     2   11 use constant n_start => 0;
  2         3  
  2         128  
44 2     2   13 use constant class_x_negative => 0;
  2         4  
  2         113  
45 2     2   13 use constant class_y_negative => 0;
  2         3  
  2         115  
46             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
47              
48 2     2   26 use constant dx_minimum => -1;
  2         4  
  2         110  
49 2     2   14 use constant dx_maximum => 1;
  2         3  
  2         99  
50 2     2   19 use constant dy_minimum => -1;
  2         5  
  2         122  
51 2     2   13 use constant dy_maximum => 1;
  2         3  
  2         197  
52             *_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::_UNDOCUMENTED__dxdy_list_eight;
53 2     2   15 use constant dsumxy_minimum => -2; # diagonals
  2         2  
  2         118  
54 2     2   14 use constant dsumxy_maximum => 2;
  2         4  
  2         101  
55 2     2   11 use constant ddiffxy_minimum => -2;
  2         4  
  2         103  
56 2     2   13 use constant ddiffxy_maximum => 2;
  2         18  
  2         109  
57 2     2   11 use constant dir_maximum_dxdy => (1,-1); # South-East
  2         4  
  2         120  
58              
59              
60             #------------------------------------------------------------------------------
61              
62             # tables generated by tools/dekking-curve-table.pl
63             # state length 200 in each of 4 tables
64 2     2   13 use vars '@_next_state','@_digit_to_x','@_digit_to_y','@_yx_to_digit';
  2         4  
  2         2151  
65             @_next_state = ( 0, 0,175,100, 25, # 0
66             0,175,100, 50,175,
67             0, 0,150, 25,150,
68             75, 75,100, 75,125,
69             150, 25, 0,125,125,
70             25, 25,100,125, 50, # 25
71             25,100,125, 75,100,
72             25, 25,175, 50,175,
73             0, 0,125, 0,150,
74             175, 50, 25,150,150,
75             50, 50,125,150, 75, # 50
76             50,125,150, 0,125,
77             50, 50,100, 75,100,
78             25, 25,150, 25,175,
79             100, 75, 50,175,175,
80             75, 75,150,175, 0, # 75
81             75,150,175, 25,150,
82             75, 75,125, 0,125,
83             50, 50,175, 50,100,
84             125, 0, 75,100,100,
85             25, 25,100,125, 50, # 100
86             25,175, 0,175,175,
87             50,125, 50,100,100,
88             75,150, 0, 75,100,
89             125, 0, 75,100,100,
90             50, 50,125,150, 75, # 125
91             50,100, 25,100,100,
92             75,150, 75,125,125,
93             0,175, 25, 0,125,
94             150, 25, 0,125,125,
95             75, 75,150,175, 0, # 150
96             75,125, 50,125,125,
97             0,175, 0,150,150,
98             25,100, 50, 25,150,
99             175, 50, 25,150,150,
100             0, 0,175,100, 25, # 175
101             0,150, 75,150,150,
102             25,100, 25,175,175,
103             50,125, 75, 50,175,
104             100, 75, 50,175,175);
105             @_digit_to_x = (0,1,2,1,0, 1,2,1,0,0, 0,1,2,2,3, 4,4,3,3,2, 3,3,4,4,4,
106             4,4,4,3,3, 2,2,1,2,1, 0,0,1,0,0, 0,1,1,2,3, 4,3,2,3,4,
107             4,3,2,3,4, 3,2,3,4,4, 4,3,2,2,1, 0,0,1,1,2, 1,1,0,0,0,
108             0,0,0,1,1, 2,2,3,2,3, 4,4,3,4,4, 4,3,3,2,1, 0,1,2,1,0,
109             4,4,4,3,3, 2,3,3,4,4, 3,2,2,1,0, 0,0,1,2,1, 0,1,2,1,0,
110             4,3,2,3,4, 3,2,1,1,0, 0,0,1,0,0, 1,2,1,2,2, 3,3,4,4,4,
111             0,0,0,1,1, 2,1,1,0,0, 1,2,2,3,4, 4,4,3,2,3, 4,3,2,3,4,
112             0,1,2,1,0, 1,2,3,3,4, 4,4,3,4,4, 3,2,3,2,2, 1,1,0,0,0);
113             @_digit_to_y = (0,0,0,1,1, 2,2,3,2,3, 4,4,3,4,4, 4,3,3,2,1, 0,1,2,1,0,
114             0,1,2,1,0, 1,2,1,0,0, 0,1,2,2,3, 4,4,3,3,2, 3,3,4,4,4,
115             4,4,4,3,3, 2,2,1,2,1, 0,0,1,0,0, 0,1,1,2,3, 4,3,2,3,4,
116             4,3,2,3,4, 3,2,3,4,4, 4,3,2,2,1, 0,0,1,1,2, 1,1,0,0,0,
117             0,1,2,1,0, 1,2,3,3,4, 4,4,3,4,4, 3,2,3,2,2, 1,1,0,0,0,
118             4,4,4,3,3, 2,3,3,4,4, 3,2,2,1,0, 0,0,1,2,1, 0,1,2,1,0,
119             4,3,2,3,4, 3,2,1,1,0, 0,0,1,0,0, 1,2,1,2,2, 3,3,4,4,4,
120             0,0,0,1,1, 2,1,1,0,0, 1,2,2,3,4, 4,4,3,2,3, 4,3,2,3,4);
121             @_yx_to_digit = (0, 1, 2,20,24, # 0
122             4, 3,19,21,23,
123             8, 5, 6,18,22,
124             9, 7,12,17,16,
125             10,11,13,14,15,
126             10, 9, 8, 4, 0, # 25
127             11, 7, 5, 3, 1,
128             13,12, 6,19, 2,
129             14,17,18,21,20,
130             15,16,22,23,24,
131             15,14,13,11,10, # 50
132             16,17,12, 7, 9,
133             22,18, 6, 5, 8,
134             23,21,19, 3, 4,
135             24,20, 2, 1, 0,
136             24,23,22,16,15, # 75
137             20,21,18,17,14,
138             2,19, 6,12,13,
139             1, 3, 5, 7,11,
140             0, 4, 8, 9,10,
141             24,23,22, 4, 0, # 100
142             20,21, 5, 3, 1,
143             16,19,18, 6, 2,
144             15,17,12, 7, 8,
145             14,13,11,10, 9,
146             14,15,16,20,24, # 125
147             13,17,19,21,23,
148             11,12,18, 5,22,
149             10, 7, 6, 3, 4,
150             9, 8, 2, 1, 0,
151             9,10,11,13,14, # 150
152             8, 7,12,17,15,
153             2, 6,18,19,16,
154             1, 3, 5,21,20,
155             0, 4,22,23,24,
156             0, 1, 2, 8, 9, # 175
157             4, 3, 6, 7,10,
158             22, 5,18,12,11,
159             23,21,19,17,13,
160             24,20,16,15,14);
161              
162             sub n_to_xy {
163 0     0 1   my ($self, $n) = @_;
164             ### DekkingCurve n_to_xy(): $n
165              
166 0 0         if ($n < 0) { return; }
  0            
167 0 0         if (is_infinite($n)) { return ($n,$n); }
  0            
168              
169 0           my $int = int($n);
170 0           $n -= $int;
171              
172 0           my @digits = digit_split_lowtohigh($int,25);
173 0           my $state = my $dirstate = 0;
174 0           my @x;
175             my @y;
176 0           foreach my $i (reverse 0 .. $#digits) {
177 0           $state += $digits[$i];
178              
179             ### $state
180             ### digit_to_x: $digit_to_x[$state]
181             ### digit_to_y: $digit_to_y[$state]
182             ### next_state: $next_state[$state]
183              
184 0 0         if ($digits[$i] != 24) { # lowest non-24 digit
185 0           $dirstate = $state;
186             }
187 0           $x[$i] = $_digit_to_x[$state];
188 0           $y[$i] = $_digit_to_y[$state];
189 0           $state = $_next_state[$state];
190             }
191              
192 0           my $zero = $int * 0;
193 0           return ($n * ($_digit_to_x[$dirstate+1] - $_digit_to_x[$dirstate])
194             + digit_join_lowtohigh(\@x, 5, $zero),
195              
196             $n * ($_digit_to_y[$dirstate+1] - $_digit_to_y[$dirstate])
197             + digit_join_lowtohigh(\@y, 5, $zero));
198             }
199              
200             sub xy_to_n {
201 0     0 1   my ($self, $x, $y) = @_;
202             ### DekkingCurve xy_to_n(): "$x, $y"
203              
204 0           $x = round_nearest ($x);
205 0           $y = round_nearest ($y);
206 0 0 0       if ($x < 0 || $y < 0) {
207 0           return undef;
208             }
209 0 0         if (is_infinite($x)) {
210 0           return $x;
211             }
212 0 0         if (is_infinite($y)) {
213 0           return $y;
214             }
215              
216 0           my @x = digit_split_lowtohigh($x,5);
217 0           my @y = digit_split_lowtohigh($y,5);
218             ### @x
219             ### @y
220              
221 0           my $state = 0;
222 0           my @n;
223              
224 0           foreach my $i (reverse 0 .. max($#x,$#y)) {
225 0   0       my $digit = $n[$i] = $_yx_to_digit[$state + 5*($y[$i]||0) + ($x[$i]||0)];
      0        
226 0           $state = $_next_state[$state+$digit];
227             }
228              
229 0           return digit_join_lowtohigh(\@n, 25, $x*0*$y); # preserve bignum
230             }
231              
232             # not exact
233             sub rect_to_n_range {
234 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
235             ### DekkingCurve rect_to_n_range(): "$x1,$y1, $x2,$y2"
236              
237 0           $x1 = round_nearest ($x1);
238 0           $x2 = round_nearest ($x2);
239 0           $y1 = round_nearest ($y1);
240 0           $y2 = round_nearest ($y2);
241              
242 0           $x2 = max($x1,$x2);
243 0           $y2 = max($y1,$y2);
244              
245 0 0 0       if ($x2 < 0 || $y2 < 0) {
246             ### rectangle all negative, no N values ...
247 0           return (1, 0);
248             }
249              
250 0           my ($pow) = round_down_pow (max($x2,$y2), 5);
251             ### $pow
252 0           return (0, 25*$pow*$pow-1);
253             }
254              
255             #------------------------------------------------------------------------------
256              
257             # shared by Math::PlanePath::CincoCurve
258             sub level_to_n_range {
259 0     0 1   my ($self, $level) = @_;
260 0           return (0, 25**$level - 1);
261             }
262             sub n_to_level {
263 0     0 1   my ($self, $n) = @_;
264 0 0         if ($n < 0) { return undef; }
  0            
265 0 0         if (is_infinite($n)) { return $n; }
  0            
266 0           $n = round_nearest($n);
267 0           my ($pow, $exp) = round_up_pow ($n+1, 25);
268 0           return $exp;
269             }
270              
271             #------------------------------------------------------------------------------
272             1;
273             __END__