File Coverage

blib/lib/Math/PlanePath/QuintetReplicate.pm
Criterion Covered Total %
statement 106 144 73.6
branch 28 46 60.8
condition 14 14 100.0
subroutine 18 20 90.0
pod 6 6 100.0
total 172 230 74.7


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             # math-image --path=QuintetReplicate --lines --scale=10
20             # math-image --path=QuintetReplicate --output=numbers --all
21             # math-image --path=QuintetReplicate,numbering_type=rotate --output=numbers --all
22             # math-image --path=QuintetReplicate --expression='5**i'
23              
24             package Math::PlanePath::QuintetReplicate;
25 1     1   9296 use 5.004;
  1         11  
26 1     1   6 use strict;
  1         2  
  1         26  
27              
28 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         66  
29             $VERSION = 128;
30 1     1   691 use Math::PlanePath;
  1         2  
  1         40  
31             @ISA = ('Math::PlanePath');
32              
33             use Math::PlanePath::Base::Generic
34 1         47 'is_infinite',
35 1     1   7 'round_nearest';
  1         2  
36             use Math::PlanePath::Base::Digits
37 1         98 'round_up_pow',
38             'digit_split_lowtohigh',
39 1     1   449 'digit_join_lowtohigh';
  1         3  
40              
41             # uncomment this to run the ### lines
42             # use Smart::Comments;
43              
44              
45 1         57 use constant parameter_info_array =>
46             [ { name => 'numbering_type',
47             display => 'Numbering',
48             share_key => 'numbering_type_rotate',
49             type => 'enum',
50             default => 'fixed',
51             choices => ['fixed','rotate'],
52             choices_display => ['Fixed','Rotate'],
53             description => 'Fixed or rotating sub-part numbering.',
54             },
55 1     1   7 ];
  1         2  
56              
57 1     1   6 use constant n_start => 0;
  1         2  
  1         41  
58 1     1   18 use constant xy_is_visited => 1;
  1         4  
  1         55  
59 1     1   6 use constant x_negative_at_n => 3;
  1         2  
  1         46  
60 1     1   5 use constant y_negative_at_n => 4;
  1         2  
  1         1217  
61              
62             #------------------------------------------------------------------------------
63             sub new {
64 4     4 1 1682 my $self = shift->SUPER::new (@_);
65 4   100     23 $self->{'numbering_type'} ||= 'fixed'; # default
66 4         9 return $self;
67             }
68              
69             # 10 7
70             # 2 8 5 6
71             # 3 0 1 9
72             # 4
73              
74             # my @digit_to_xbx = (0,1,0,-1,0);
75             # my @digit_to_xby = (0,0,-1,0,1);
76             # my @digit_to_y = (0,0,1,0,-1);
77             # my @digit_to_yby = (0,0,1,0,-1);
78             # $x += $bx * $digit_to_xbx[$digit] + $by * $digit_to_xby[$digit];
79             # $y += $bx * $digit_to_ybx[$digit] + $by * $digit_to_yby[$digit];
80              
81             sub _digits_rotate_lowtohigh {
82 262     262   1557 my ($aref) = @_;
83 262         348 my $rot = 0;
84 262         446 foreach my $digit (reverse @$aref) { # high to low
85 712 100       1235 if ($digit) {
86 619         920 $rot += $digit-1;
87 619         988 $digit = ($rot % 4) + 1; # mutate $aref
88             }
89             }
90             }
91             sub _digits_unrotate_lowtohigh {
92 647     647   5652 my ($aref) = @_;
93 647         915 my $rot = 0;
94 647         1099 foreach my $digit (reverse @$aref) { # high to low
95 1802 100       3086 if ($digit) {
96 1585         2223 $digit = ($digit-1-$rot) % 4; # mutate $aref
97 1585         2037 $rot += $digit;
98 1585         2322 $digit++;
99             }
100             }
101             }
102              
103             sub n_to_xy {
104 250     250 1 1671 my ($self, $n) = @_;
105             ### QuintetReplicate n_to_xy(): $n
106              
107 250 50       491 if ($n < 0) {
108 0         0 return;
109             }
110 250 50       478 if (is_infinite($n)) {
111 0         0 return ($n,$n);
112             }
113              
114             # any value in long frac lines like this?
115             {
116 250         402 my $int = int($n);
  250         396  
117 250 50       416 if ($n != $int) {
118 0         0 my ($x1,$y1) = $self->n_to_xy($int);
119 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
120 0         0 my $frac = $n - $int; # inherit possible BigFloat
121 0         0 my $dx = $x2-$x1;
122 0         0 my $dy = $y2-$y1;
123 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
124             }
125 250         368 $n = $int; # BigFloat int() gives BigInt, use that
126             }
127              
128 250         382 my $x = my $y = my $by = ($n * 0); # inherit bignum 0
129 250         381 my $bx = $x+1; # inherit bignum 1
130              
131 250         487 my @digits = digit_split_lowtohigh($n,5);
132 250 100       498 if ($self->{'numbering_type'} eq 'rotate') {
133 125         226 _digits_rotate_lowtohigh(\@digits);
134             }
135 250         427 foreach my $digit (@digits) {
136             ### $digit
137             ### $bx
138             ### $by
139              
140 688 100       1428 if ($digit == 1) {
    100          
    100          
    100          
141 150         200 $x += $bx;
142 150         194 $y += $by;
143             } elsif ($digit == 2) {
144 150         199 $x -= $by; # i*(bx+i*by) = rotate +90
145 150         230 $y += $bx;
146             } elsif ($digit == 3) {
147 150         215 $x -= $bx; # -1*(bx+i*by) = rotate 180
148 150         213 $y -= $by;
149             } elsif ($digit == 4) {
150 150         207 $x += $by; # -i*(bx+i*by) = rotate -90
151 150         209 $y -= $bx;
152             }
153              
154             # power (bx,by) = (bx + i*by)*(i+2)
155             #
156 688         1219 ($bx,$by) = (2*$bx-$by, 2*$by+$bx);
157             }
158              
159 250         561 return ($x, $y);
160             }
161              
162             # digit modulus 2Y+X mod 5
163             # 2 2
164             # 3 0 1 1 0 4
165             # 4 3
166             #
167             my @modulus_to_x = (0,-1,0,0,1);
168             my @modulus_to_y = (0,0,1,-1,0);
169             my @modulus_to_digit = (0,3,2,4,1);
170              
171             sub xy_to_n {
172 770     770 1 3835 my ($self, $x, $y) = @_;
173             ### QuintetReplicate xy_to_n(): "$x, $y"
174              
175 770         1382 $x = round_nearest ($x);
176 770         1422 $y = round_nearest ($y);
177              
178 770         1524 foreach my $overflow (2*$x + 2*$y, 2*$x - 2*$y) {
179 1540 50       2807 if (is_infinite($overflow)) { return $overflow; }
  0         0  
180             }
181              
182 770         1239 my $zero = ($x * 0 * $y); # inherit bignum 0
183 770         1040 my @n; # digits low to high
184              
185 770   100     1551 while ($x || $y) {
186             ### at: "$x,$y"
187              
188 2180         3550 my $m = (2*$y - $x) % 5;
189             ### $m
190             ### digit: $modulus_to_digit[$m]
191              
192 2180         3456 push @n, $modulus_to_digit[$m];
193              
194 2180         2999 $x -= $modulus_to_x[$m];
195 2180         2753 $y -= $modulus_to_y[$m];
196             ### modulus shift to: "$x,$y"
197              
198             # div i+2,
199             # = (i*y + x) * (i-2)/-5
200             # = (-y -2*y*i + x*i -2*x) / -5
201             # = (y + 2*y*i - x*i + 2*x) / 5
202             # = (2x+y + (2*y-x)i) / 5
203             #
204             # ### assert: ((2*$x + $y) % 5) == 0
205             # ### assert: ((2*$y - $x) % 5) == 0
206              
207 2180         6640 ($x,$y) = ((2*$x + $y) / 5,
208             (2*$y - $x) / 5);
209             }
210 770 100       1505 if ($self->{'numbering_type'} eq 'rotate') {
211 385         731 _digits_unrotate_lowtohigh(\@n);
212             }
213 770         1731 return digit_join_lowtohigh (\@n, 5, $zero);
214             }
215              
216             # level min x^2+y^2 for N >= 5^k
217             # 0 1 at 1,0
218             # 1 2 at 1,1 factor 2
219             # 2 5 at 1,2 factor 2.5
220             # 3 16 at 0,4 factor 3.2
221             # 4 65 at -4,7 factor 4.0625
222             # 5 296 at -14,10 factor 4.55384615384615
223             # 6 1405 at -37,6 factor 4.74662162162162
224             # 7 6866 at -79,-25 factor 4.88683274021352
225             #
226             # not exact
227             sub rect_to_n_range {
228 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
229              
230 0         0 $x1 = abs($x1);
231 0         0 $x2 = abs($x2);
232 0         0 $y1 = abs($y1);
233 0         0 $y2 = abs($y2);
234 0 0       0 if ($x1 < $x2) { $x1 = $x2; }
  0         0  
235 0 0       0 if ($y1 < $y2) { $y1 = $y2; }
  0         0  
236 0         0 my $rsquared = $x1*$x1 + $y1*$y1;
237 0 0       0 if (is_infinite($rsquared)) {
238 0         0 return (0, $rsquared);
239             }
240              
241 0         0 my $x = 1;
242 0         0 my $y = 0;
243 0         0 for (my $level = 1; ; $level++) {
244             # (x+iy)*(2+i)
245 0         0 ($x,$y) = (2*$x - $y, $x + 2*$y);
246 0 0       0 if (abs($x) >= abs($y)) {
247 0         0 $x -= ($x<=>0);
248             } else {
249 0         0 $y -= ($y<=>0);
250             }
251              
252 0 0       0 unless ($x*$x + $y*$y <= $rsquared) {
253 0         0 return (0, 5**$level - 1);
254             }
255             }
256             }
257              
258             #------------------------------------------------------------------------------
259             # levels
260              
261             sub level_to_n_range {
262 2     2 1 18 my ($self, $level) = @_;
263 2         9 return (0, 5**$level - 1);
264             }
265             sub n_to_level {
266 0     0 1 0 my ($self, $n) = @_;
267 0 0       0 if ($n < 0) { return undef; }
  0         0  
268 0 0       0 if (is_infinite($n)) { return $n; }
  0         0  
269 0         0 $n = round_nearest($n);
270 0         0 my ($pow, $exp) = round_up_pow ($n+1, 5);
271 0         0 return $exp;
272             }
273              
274              
275             #------------------------------------------------------------------------------
276              
277             # Return true if $n is on the boundary of $level.
278             #
279             sub _UNDOCUMENTED__n_is_boundary_level {
280 250     250   1692 my ($self, $n, $level) = @_;
281              
282             ### _UNDOCUMENTED__n_is_boundary_level(): "n=$n"
283              
284 250         473 my @digits = digit_split_lowtohigh($n,5);
285             ### @digits
286 250 100       520 if ($self->{'numbering_type'} eq 'fixed') {
287 125         223 _digits_unrotate_lowtohigh(\@digits);
288             ### @digits
289             }
290              
291             # no high 0 digit (and nothing too big)
292 250 100       512 if (@digits != $level) {
293 50         108 return 0;
294             }
295              
296             # no 0 digit anywhere else
297 200 100       325 if (grep {$_==0} @digits) {
  600         1311  
298 72         154 return 0;
299             }
300              
301             # skip high digit and all 1 digits
302 128         182 pop @digits;
303 128         199 @digits = grep {$_ != 1} @digits;
  256         471  
304              
305 128         304 for (my $i = 0; $i < $#digits; $i++) { # low to high
306 72 100 100     688 if (($digits[$i+1] == 3 && $digits[$i] <= 3) # 33, 32
      100        
      100        
307             || ($digits[$i+1] == 4 && $digits[$i] == 4)) { # 44
308             ### no, pair at: $i
309 24         65 return 0;
310             }
311             }
312 104         222 return 1;
313             }
314              
315              
316             #------------------------------------------------------------------------------
317             1;
318             __END__