File Coverage

blib/lib/Math/PlanePath/CubicBase.pm
Criterion Covered Total %
statement 118 145 81.3
branch 37 48 77.0
condition 11 15 73.3
subroutine 14 19 73.6
pod 7 7 100.0
total 187 234 79.9


line stmt bran cond sub pod time code
1             # Copyright 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             # math-image --path=CubicBase --all --output=numbers --size=60x20
20             # math-image --path=CubicBase --values=Multiples,multiples=27 --output=numbers --size=60x20
21              
22             # math-image --path=CubicBase --expression='i<128?i:0' --output=numbers --size=132x20
23             #
24              
25             package Math::PlanePath::CubicBase;
26 1     1   9270 use 5.004;
  1         9  
27 1     1   5 use strict;
  1         2  
  1         38  
28             #use List::Util 'max';
29             *max = \&Math::PlanePath::_max;
30              
31 1     1   15 use vars '$VERSION', '@ISA';
  1         4  
  1         76  
32             $VERSION = 129;
33 1     1   747 use Math::PlanePath;
  1         2  
  1         41  
34             @ISA = ('Math::PlanePath');
35              
36             use Math::PlanePath::Base::Generic
37 1         45 'is_infinite',
38 1     1   6 'round_nearest';
  1         2  
39             use Math::PlanePath::Base::Digits
40 1         69 'parameter_info_array',
41             'digit_split_lowtohigh',
42 1     1   503 'digit_join_lowtohigh';
  1         2  
43              
44             # uncomment this to run the ### lines
45             #use Smart::Comments;
46              
47              
48 1     1   6 use constant n_start => 0;
  1         2  
  1         131  
49             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_even;
50              
51             # use constant parameter_info_array =>
52             # [ Math::PlanePath::Base::Digits::parameter_info_radix2(),
53             #
54             # # Experimental ...
55             # # { name => 'skewed',
56             # # type => 'boolean',
57             # # default => 0,
58             # # },
59             # ];
60              
61             sub x_negative_at_n {
62 0     0 1 0 my ($self) = @_;
63 0         0 return $self->{'radix'};
64             }
65             sub y_negative_at_n {
66 0     0 1 0 my ($self) = @_;
67 0         0 return $self->{'radix'}**2;
68             }
69 1     1   7 use constant absdx_minimum => 2;
  1         1  
  1         72  
70 1     1   6 use constant dir_maximum_dxdy => (-1, -3); # supremum
  1         2  
  1         956  
71              
72             sub turn_any_straight {
73 0     0 1 0 my ($self) = @_;
74 0         0 return $self->{'radix'} > 2; # never straight in radix=2
75             }
76             sub _UNDOCUMENTED__turn_any_left_at_n {
77 0     0   0 my ($self) = @_;
78 0         0 return $self->{'radix'} - 1;
79             }
80             sub _UNDOCUMENTED__turn_any_right_at_n {
81 0     0   0 my ($self) = @_;
82 0         0 return $self->{'radix'};
83             }
84              
85              
86             #------------------------------------------------------------------------------
87             sub new {
88 6     6 1 1748 my $self = shift->SUPER::new(@_);
89              
90 6         13 my $radix = $self->{'radix'};
91 6 100 66     28 if (! defined $radix || $radix <= 2) { $radix = 2; }
  3         4  
92 6         11 $self->{'radix'} = $radix;
93              
94 6         13 return $self;
95             }
96              
97             sub n_to_xy {
98 33     33 1 3244 my ($self, $n) = @_;
99             ### CubicBase n_to_xy(): "$n"
100              
101 33 50       79 if ($n < 0) { return; }
  0         0  
102 33 50       92 if (is_infinite($n)) { return ($n,$n); }
  0         0  
103              
104             # is this sort of midpoint worthwhile? not documented yet
105             {
106 33         59 my $int = int($n);
  33         50  
107             ### $int
108             ### $n
109 33 50       65 if ($n != $int) {
110 0         0 my ($x1,$y1) = $self->n_to_xy($int);
111 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
112 0         0 my $frac = $n - $int; # inherit possible BigFloat
113 0         0 my $dx = $x2-$x1;
114 0         0 my $dy = $y2-$y1;
115 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
116             }
117 33         53 $n = $int; # BigFloat int() gives BigInt, use that
118             }
119              
120 33         46 my $x = 0;
121 33         42 my $y = 0;
122              
123 33         51 my $radix = $self->{'radix'};
124 33 100       80 if (my @digits = digit_split_lowtohigh($n,$radix)) {
125 31         58 my $len = ($n * 0) + 1; # inherit bignum 1
126 31         40 my $ext = 1;
127 31         42 for (;;) {
128             { # 0 degrees
129 37         49 $x += (2*(shift @digits)) * $len; # low to high
  37         64  
130             }
131 37 100       69 @digits || last;
132              
133 29 100       55 if ($ext ^= 1) {
134 4         6 $len *= $radix;
135             }
136              
137             { # +120 degrees
138 29         40 my $dlen = (shift @digits) * $len; # low to high
  29         43  
139 29         38 $x -= $dlen;
140 29         41 $y += $dlen;
141             }
142 29 100       53 @digits || last;
143              
144 10 100       43 if ($ext ^= 1) {
145 8         18 $len *= $radix;
146             }
147              
148             { # +240 degrees
149 10         15 my $dlen = (shift @digits) * $len; # low to high
  10         15  
150 10         14 $x -= $dlen;
151 10         14 $y -= $dlen;
152             }
153 10 100       19 @digits || last;
154              
155 6 50       15 if ($ext ^= 1) {
156 0         0 $len *= $radix;
157             }
158             }
159              
160 31 50       62 if ($self->{'skewed'}) {
161 0         0 $x = ($x + $y) / 2;
162             }
163             }
164              
165             ### result: "$x,$y"
166 33         77 return ($x,$y);
167             }
168              
169             sub xy_to_n {
170 33     33 1 2693 my ($self, $x, $y) = @_;
171             ### CubicBase xy_to_n(): "$x, $y"
172              
173 33         80 $x = round_nearest ($x);
174 33         67 $y = round_nearest ($y);
175 33 50       68 if (is_infinite($x)) { return ($x); }
  0         0  
176 33 50       70 if (is_infinite($y)) { return ($y); }
  0         0  
177              
178 33 50       77 if ($self->{'skewed'}) {
179 0         0 $x = 2*$x - $y;
180             } else {
181 33 50       73 if (($x + $y) % 2) {
182             # nothing on odd squares, only A2 even squares
183 0         0 return undef;
184             }
185             }
186             # $x = ($x-$y)/2; # into i,j coordinates
187              
188 33         75 foreach my $overflow ($x+$y, $x-$y) {
189 66 50       128 if (is_infinite($overflow)) { return $overflow; }
  0         0  
190             }
191              
192 33         60 my $radix = $self->{'radix'};
193 33         47 my $zero = ($x * 0 * $y); # inherit bignum 0
194 33         50 my @n; # digits low to high
195              
196 33 100 100     71 if ($x || $y) {
197 31         44 my $ext = 1;
198              
199 31         39 for (;;) {
200             ### at: "x=$x y=$y"
201              
202             {
203 37         45 my $digit = (($x+$y)/2) % $radix;
  37         84  
204 37         70 push @n, $digit;
205 37         72 $x -= 2*$digit;
206              
207             ### 0deg digit: $digit
208             ### subtract to: "x=$x y=$y"
209             }
210              
211 37 100 66     87 last unless $x || $y;
212 29 100       61 if ($ext ^= 1) {
213             ### assert: ($x % $radix) == 0
214             ### assert: ($y % $radix) == 0
215 4         5 $x = int($x/$radix);
216 4         9 $y = int($y/$radix);
217             ### divide out to: "x=$x y=$y"
218             }
219              
220             {
221 29         34 my $digit = (($y-$x)/2) % $radix;
  29         47  
222 29         45 push @n, $digit;
223 29         33 $x += $digit;
224 29         45 $y -= $digit;
225              
226             ### 120deg digit: $digit
227             ### subtract to: "x=$x y=$y"
228             }
229              
230 29 100 66     81 last unless $x || $y;
231 10 100       23 if ($ext ^= 1) {
232             ### assert: ($x % $radix) == 0
233             ### assert: ($y % $radix) == 0
234 8         16 $x = int($x/$radix);
235 8         11 $y = int($y/$radix);
236             ### divide out to: "x=$x y=$y"
237             }
238              
239             {
240 10         11 my $digit = (-$y) % $radix;
  10         19  
241 10         13 push @n, $digit;
242 10         12 $x += $digit;
243 10         94 $y += $digit;
244              
245             ### 240deg digit: $digit
246             ### subtract to: "x=$x y=$y"
247             }
248              
249 10 100 66     30 last unless $x || $y;
250 6 50       12 if ($ext ^= 1) {
251             ### assert: ($x % $radix) == 0
252             ### assert: ($y % $radix) == 0
253 0         0 $x = int($x/$radix);
254 0         0 $y = int($y/$radix);
255             ### divide out to: "x=$x y=$y"
256             }
257             }
258             }
259              
260 33         92 return digit_join_lowtohigh (\@n, $radix, $zero);
261             }
262              
263             # ENHANCE-ME: Can probably do better by measuring extents in 3 directions
264             # for a hexagonal boundary.
265             #
266             # not exact
267             sub rect_to_n_range {
268 33     33 1 3391 my ($self, $x1,$y1, $x2,$y2) = @_;
269             ### CubicBase rect_to_n_range(): "$x1,$y1 $x2,$y2"
270              
271 33         83 $x1 = round_nearest ($x1);
272 33         67 $y1 = round_nearest ($y1);
273 33         61 $x2 = round_nearest ($x2);
274 33         60 $y2 = round_nearest ($y2);
275              
276 33         56 my $radix = $self->{'radix'};
277 33         77 my $xm = max(abs($x1),abs($x2)) * $radix*$radix*$radix;
278 33         67 my $ym = max(abs($y1),abs($y2)) * $radix*$radix*$radix;
279              
280 33         79 return (0,
281             $xm*$xm+$ym*$ym);
282             }
283              
284             #------------------------------------------------------------------------------
285             # levels
286              
287 1     1   522 use Math::PlanePath::ImaginaryBase;
  1         2  
  1         60  
288             *level_to_n_range = \&Math::PlanePath::ImaginaryBase::level_to_n_range;
289             *n_to_level = \&Math::PlanePath::ImaginaryBase::n_to_level;
290              
291              
292             #------------------------------------------------------------------------------
293             1;
294             __END__