File Coverage

blib/lib/Math/PlanePath/PeanoDiagonals.pm
Criterion Covered Total %
statement 99 114 86.8
branch 26 38 68.4
condition 7 12 58.3
subroutine 23 26 88.4
pod 7 7 100.0
total 162 197 82.2


line stmt bran cond sub pod time code
1             # Copyright 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::PeanoDiagonals;
20 1     1   9111 use 5.004;
  1         10  
21 1     1   6 use strict;
  1         2  
  1         25  
22              
23 1     1   5 use vars '$VERSION', '@ISA';
  1         1  
  1         69  
24             $VERSION = 128;
25 1     1   690 use Math::PlanePath;
  1         2  
  1         38  
26             @ISA = ('Math::PlanePath');
27              
28 1     1   7 use Math::PlanePath;
  1         1  
  1         40  
29             *max = \&Math::PlanePath::_max;
30              
31 1     1   524 use Math::PlanePath::PeanoCurve;
  1         2  
  1         53  
32             *_n_to_xykk = \&Math::PlanePath::PeanoCurve::_n_to_xykk;
33             *_xykk_to_n = \&Math::PlanePath::PeanoCurve::_xykk_to_n;
34              
35             use Math::PlanePath::Base::Generic
36 1         49 'is_infinite',
37 1     1   7 'round_nearest';
  1         2  
38             use Math::PlanePath::Base::Digits
39 1         45 'round_up_pow',
40             'round_down_pow',
41             'digit_split_lowtohigh',
42 1     1   6 'digit_join_lowtohigh';
  1         2  
43              
44              
45             # uncomment this to run the ### lines
46             # use Smart::Comments;
47              
48              
49 1     1   6 use constant n_start => 0;
  1         2  
  1         50  
50 1     1   5 use constant class_x_negative => 0;
  1         2  
  1         42  
51 1     1   5 use constant class_y_negative => 0;
  1         2  
  1         38  
52 1     1   5 use constant turn_any_straight => 0; # never straight
  1         3  
  1         43  
53              
54 1     1   6 use constant dx_minimum => -1;
  1         2  
  1         41  
55 1     1   5 use constant dx_maximum => 1;
  1         2  
  1         39  
56 1     1   6 use constant dy_minimum => -1;
  1         1  
  1         39  
57 1     1   5 use constant dy_maximum => 1;
  1         2  
  1         85  
58              
59 1         1206 use constant parameter_info_array =>
60             [ { name => 'radix',
61             share_key => 'radix_3',
62             display => 'Radix',
63             type => 'integer',
64             minimum => 2,
65             default => 3,
66             width => 3,
67 1     1   15 } ];
  1         2  
68              
69             # odd radix is unit steps diagonally,
70             # even radix unlimited
71             sub _UNDOCUMENTED__dxdy_list {
72 0     0   0 my ($self) = @_;
73 0 0       0 return ($self->{'radix'} % 2
74             ? (1,1, -1,1, -1,-1, 1,-1)
75             : ()); # even, unlimited
76             }
77              
78             sub new {
79 58     58 1 8391 my $self = shift->SUPER::new(@_);
80              
81 58 100 66     293 if (! $self->{'radix'} || $self->{'radix'} < 2) {
82 7         18 $self->{'radix'} = 3;
83             }
84 58         114 return $self;
85             }
86              
87             sub n_to_xy {
88 40404     40404 1 175588 my ($self, $n) = @_;
89             ### PeanoDiagonals n_to_xy(): "$n"
90 40404 100       78383 if ($n < 0) { # negative
91 1         6 return;
92             }
93 40403 50       80464 if (is_infinite($n)) {
94 0         0 return ($n,$n);
95             }
96              
97 40403         68353 my $frac;
98             {
99 40403         54968 my $int = int($n);
  40403         55036  
100 40403         61102 $frac = $n - $int; # inherit possible BigFloat
101 40403         61037 $n = $int;
102             }
103              
104 40403         85757 my ($x,$y, $xk,$yk) = _n_to_xykk($self,$n);
105             ### xykk: "$x,$y $xk,$yk"
106              
107 40403 100       157985 return ($x + ($xk&1 ? 1-$frac : $frac),
    100          
108             $y + ($yk&1 ? 1-$frac : $frac));
109             }
110              
111             sub xy_to_n {
112 0     0 1 0 return scalar((shift->xy_to_n_list(@_))[0]);
113             }
114             sub xy_to_n_list {
115 40     40 1 5166 my ($self, $x, $y) = @_;
116             ### PeanoDiagonals xy_to_n(): "$x, $y"
117              
118             # For odd radix, if X is even then segments are NE or SW, so offset 0,0 or
119             # 1,1 to go to "middle" points. Conversely if X is odd then segments are
120             # NW or SE so offset 0,1 or 1,0.
121             #
122             # ENHANCE-ME: For odd radix, the two offsets are exactly the two visits.
123             # Should be able to pay attention to the low 0s or 2s and so have the
124             # digits of both N in one look.
125             #
126             # ENHANCE-ME: Is the offset rule for even radix found as easily?
127              
128 40         123 $x = round_nearest ($x);
129 40         84 $y = round_nearest ($y);
130              
131 40 100 66     176 if ($x < 0 || $y < 0) { return; }
  1         4  
132 39 50       84 if (is_infinite($x)) { return $x; }
  0         0  
133 39 50       95 if (is_infinite($y)) { return $y; }
  0         0  
134              
135             return
136 18         80 sort {$a<=>$b}
137 122         330 map {_xykk_to_n($self, $x,$y, @$_)}
138 39 100       182 ($self->{'radix'}&1
    100          
139             ? ($x&1 ? ([0,1],[1,0]) : ([0,0],[1,1]))
140             : ([0,0],[1,1], [0,1],[1,0]));
141             }
142              
143              
144             #------------------------------------------------------------------------------
145             # not exact
146             # block 0 .. 3^k-1 contains all
147              
148             sub rect_to_n_range {
149 47     47 1 4568 my ($self, $x1,$y1, $x2,$y2) = @_;
150              
151 47         137 $x1 = round_nearest ($x1);
152 47         97 $y1 = round_nearest ($y1);
153 47         96 $x2 = round_nearest ($x2);
154 47         101 $y2 = round_nearest ($y2);
155 47 50       137 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
156 47 50       90 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
157             ### rect_to_n_range(): "$x1,$y1 to $x2,$y2"
158              
159 47 50 33     171 if ($x2 < 0 || $y2 < 0) {
160 0         0 return (1, 0);
161             }
162              
163 47         98 my $radix = $self->{'radix'};
164              
165 47         147 my ($power, $level) = round_down_pow (max($x2,$y2)*$radix, $radix);
166 47 50       127 if (is_infinite($level)) {
167 0         0 return (0, $level);
168             }
169 47         138 return (0, $power*$power - 1);
170             }
171              
172             #------------------------------------------------------------------------------
173             # levels
174              
175             sub level_to_n_range {
176 3     3 1 215 my ($self, $level) = @_;
177 3         11 return (0, $self->{'radix'}**(2*$level));
178             }
179             sub n_to_level {
180 0     0 1 0 my ($self, $n) = @_;
181 0 0       0 if ($n < 0) { return undef; }
  0         0  
182 0         0 $n = round_nearest($n);
183 0         0 my ($pow, $exp) = round_up_pow ($n, $self->{'radix'}*$self->{'radix'});
184 0         0 return $exp;
185             }
186              
187             #------------------------------------------------------------------------------
188              
189             # num low ternary 0s, and whether odd or even above there which is parity of
190             # how many 1-digits
191             #
192             sub _UNDOCUMENTED__n_to_turn_LSR {
193 20180     20180   534064 my ($self, $n) = @_;
194 20180 100 66     51756 if ($n < 1 || is_infinite($n)) { return undef; }
  2         6  
195 20178         37293 my $radix = $self->{'radix'};
196 20178 50       38218 if ($radix & 1) {
197 20178         28101 my $turn = 1;
198 20178         39530 until ($n % $radix) { # parity of low 0s
199 3704         5097 $turn = -$turn;
200 3704         7450 $n /= $radix;
201             }
202 20178 100       47066 return ($n % 2 ? -$turn : $turn); # and flip again if odd
203             }
204 0           return $self->SUPER::_UNDOCUMENTED__n_to_turn_LSR($n);
205             }
206              
207             #------------------------------------------------------------------------------
208              
209             1;
210             __END__