File Coverage

blib/lib/Math/PlanePath/GosperReplicate.pm
Criterion Covered Total %
statement 115 140 82.1
branch 24 34 70.5
condition 8 8 100.0
subroutine 23 25 92.0
pod 6 6 100.0
total 176 213 82.6


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             # math-image --path=GosperReplicate --lines --scale=10
20             # math-image --path=GosperReplicate --all --output=numbers_dash
21             # math-image --path=GosperReplicate,numbering_type=rotate --all --output=numbers_dash
22             #
23              
24             package Math::PlanePath::GosperReplicate;
25 1     1   1770 use 5.004;
  1         4  
26 1     1   5 use strict;
  1         2  
  1         24  
27 1     1   6 use List::Util qw(max);
  1         2  
  1         89  
28 1     1   497 use POSIX 'ceil';
  1         6391  
  1         6  
29 1     1   2011 use Math::Libm 'hypot';
  1         3390  
  1         68  
30 1     1   714 use Math::PlanePath::SacksSpiral;
  1         3  
  1         39  
31              
32 1     1   7 use vars '$VERSION', '@ISA';
  1         2  
  1         53  
33             $VERSION = 128;
34 1     1   7 use Math::PlanePath;
  1         2  
  1         30  
35             @ISA = ('Math::PlanePath');
36              
37             use Math::PlanePath::Base::Generic
38 1         61 'is_infinite',
39 1     1   5 'round_nearest';
  1         3  
40             use Math::PlanePath::Base::Digits
41 1         90 'round_up_pow',
42             'digit_split_lowtohigh',
43 1     1   675 'digit_join_lowtohigh';
  1         3  
44              
45             # uncomment this to run the ### lines
46             #use Smart::Comments;
47              
48              
49 1         58 use constant parameter_info_array =>
50             [ { name => 'numbering_type',
51             display => 'Numbering',
52             share_key => 'numbering_type_rotate',
53             type => 'enum',
54             default => 'fixed',
55             choices => ['fixed','rotate'],
56             choices_display => ['Fixed','Rotate'],
57             description => 'Fixed or rotating sub-part numbering.',
58             },
59 1     1   7 ];
  1         2  
60              
61 1     1   6 use constant n_start => 0;
  1         2  
  1         88  
62             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_even;
63              
64 1     1   7 use constant x_negative_at_n => 3;
  1         2  
  1         42  
65 1     1   6 use constant y_negative_at_n => 5;
  1         2  
  1         37  
66 1     1   6 use constant absdx_minimum => 1;
  1         2  
  1         57  
67 1     1   7 use constant dir_maximum_dxdy => (3,-1);
  1         2  
  1         1133  
68              
69             #------------------------------------------------------------------------------
70             sub new {
71 6     6 1 1228 my $self = shift->SUPER::new (@_);
72 6   100     40 $self->{'numbering_type'} ||= 'fixed'; # default
73 6         15 return $self;
74             }
75              
76             sub _digits_rotate_lowtohigh {
77 7626     7626   14870 my ($aref) = @_;
78 7626         10242 my $rot = 0;
79 7626         13285 foreach my $digit (reverse @$aref) {
80 25123 100       41546 if ($digit) {
81 22617         29236 $rot += $digit-1;
82 22617         34919 $digit = ($rot % 6) + 1; # mutate $aref
83             }
84             }
85             }
86             sub _digits_unrotate_lowtohigh {
87 16009     16009   38151 my ($aref) = @_;
88 16009         22907 my $rot = 0;
89 16009         28681 foreach my $digit (reverse @$aref) {
90 58866 100       95623 if ($digit) {
91 52553         70807 $digit = ($digit-1-$rot) % 6; # mutate $aref
92 52553         66000 $rot += $digit;
93 52553         76548 $digit++;
94             }
95             }
96             }
97              
98             sub n_to_xy {
99 10690     10690 1 95086 my ($self, $n) = @_;
100             ### GosperReplicate n_to_xy(): $n
101              
102 10690 50       19694 if ($n < 0) {
103 0         0 return;
104             }
105 10690 50       21610 if (is_infinite($n)) {
106 0         0 return ($n,$n);
107             }
108              
109             {
110 10690         18738 my $int = int($n);
  10690         14814  
111             ### $int
112             ### $n
113 10690 50       18825 if ($n != $int) {
114 0         0 my ($x1,$y1) = $self->n_to_xy($int);
115 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
116 0         0 my $frac = $n - $int; # inherit possible BigFloat
117 0         0 my $dx = $x2-$x1;
118 0         0 my $dy = $y2-$y1;
119 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
120             }
121 10690         15350 $n = $int; # BigFloat int() gives BigInt, use that
122             }
123              
124 10690         14941 my $x = my $y = $n*0; # inherit bigint from $n
125 10690         15057 my $sx = $x + 2; # 2
126 10690         14547 my $sy = $x; # 0
127              
128             # digit
129             # 3 2
130             # \ /
131             # 4---0---1
132             # / \
133             # 5 6
134              
135 10690         20289 my @digits = digit_split_lowtohigh($n,7);
136 10690 100       21754 if ($self->{'numbering_type'} eq 'rotate') {
137 7260         12703 _digits_rotate_lowtohigh(\@digits);
138             }
139              
140 10690         17432 foreach my $digit (@digits) {
141             ### digit: "$digit $x,$y side $sx,$sy"
142              
143 33828 100       78764 if ($digit == 1) {
    100          
    100          
    100          
    100          
    100          
144             ### right ...
145             # $x = -$x; # rotate 180
146             # $y = -$y;
147 5258         7405 $x += $sx;
148 5258         6965 $y += $sy;
149             } elsif ($digit == 2) {
150             ### up right ...
151             # ($x,$y) = ((3*$y-$x)/2, # rotate -120
152             # ($x+$y)/-2);
153 5258         8951 $x += ($sx - 3*$sy)/2; # at +60
154 5258         7838 $y += ($sx + $sy)/2;
155              
156             } elsif ($digit == 3) {
157             ### up left ...
158             # ($x,$y) = (($x+3*$y)/2, # -60
159             # ($y-$x)/2);
160 5258         8851 $x += ($sx + 3*$sy)/-2; # at +120
161 5258         7800 $y += ($sx - $sy)/2;
162              
163             } elsif ($digit == 4) {
164             ### left
165 4915         7027 $x -= $sx; # at -180
166 4915         6742 $y -= $sy;
167              
168             } elsif ($digit == 5) {
169             ### down left
170             # ($x,$y) = (($x-3*$y)/2, # rotate +60
171             # ($x+$y)/2);
172 4915         8434 $x += (3*$sy - $sx)/2; # at -120
173 4915         7195 $y += ($sx + $sy)/-2;
174              
175             } elsif ($digit == 6) {
176             ### down right
177             # ($x,$y) = (($x+3*$y)/-2, # rotate +120
178             # ($x-$y)/2);
179 4915         8396 $x += ($sx + 3*$sy)/2; # at -60
180 4915         7260 $y += ($sy - $sx)/2;
181             }
182              
183             # 2*(sx,sy) + rot+60(sx,sy)
184 33828         64068 ($sx,$sy) = ((5*$sx - 3*$sy) / 2,
185             ($sx + 5*$sy) / 2);
186             }
187 10690         25235 return ($x,$y);
188             }
189              
190             # modulus
191             # 1 3
192             # \ /
193             # 5---0---2
194             # / \
195             # 4 6
196             # 0 1 2 3 4 5 6
197             my @modulus_to_x = (0,-1, 2, 1,-1,-2, 1);
198             my @modulus_to_y = (0, 1, 0, 1,-1, 0,-1);
199             my @modulus_to_digit = (0, 3, 1, 2, 5, 4, 6);
200              
201             sub xy_to_n {
202 15643     15643 1 81716 my ($self, $x, $y) = @_;
203             ### GosperReplicate xy_to_n(): "$x, $y"
204              
205 15643         30780 $x = round_nearest($x);
206 15643         29807 $y = round_nearest($y);
207 15643 50       31324 if (($x + $y) % 2) {
208 0         0 return undef;
209             }
210              
211 15643         25593 my $level = _xy_to_level_ceil($x,$y);
212 15643 50       32880 if (is_infinite($level)) {
213 0         0 return $level;
214             }
215              
216 15643         29084 my $zero = ($x * 0 * $y); # inherit bignum 0
217 15643         20591 my @n; # digits low to high
218              
219 15643   100     39776 while ($level-- >= 0 && ($x || $y)) {
      100        
220             ### at: "$x,$y m=".(($x + 2*$y) % 7)
221              
222 57851         91548 my $m = ($x + 2*$y) % 7;
223 57851         86982 push @n, $modulus_to_digit[$m];
224 57851         76695 $x -= $modulus_to_x[$m];
225 57851         72436 $y -= $modulus_to_y[$m];
226              
227             ### digit: "to $x,$y"
228             ### assert: (3 * $y + 5 * $x) % 14 == 0
229             ### assert: (5 * $y - $x) % 14 == 0
230              
231             # shrink
232 57851         206228 ($x,$y) = ((3*$y + 5*$x) / 14,
233             (5*$y - $x) / 14);
234             }
235              
236 15643 50       32136 if ($self->{'numbering_type'} eq 'rotate') {
237 15643         29079 _digits_unrotate_lowtohigh(\@n);
238             }
239 15643         35893 return digit_join_lowtohigh (\@n, 7, $zero);
240             }
241              
242              
243             # not exact
244             sub rect_to_n_range {
245 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
246 0         0 $y1 *= sqrt(3);
247 0         0 $y2 *= sqrt(3);
248 0         0 my ($r_lo, $r_hi) = Math::PlanePath::SacksSpiral::_rect_to_radius_range
249             ($x1,$y1, $x2,$y2);
250 0         0 $r_hi *= 2;
251 0         0 my $level_plus_1 = ceil( log(max(1,$r_hi/4)) / log(sqrt(7)) ) + 2;
252 0         0 return (0, 7**$level_plus_1 - 1);
253             }
254              
255             sub _xy_to_level_ceil {
256 15643     15643   24655 my ($x,$y) = @_;
257 15643         32857 my $r = hypot($x,$y);
258 15643         22093 $r *= 2;
259 15643         50193 return ceil( log(max(1,$r/4)) / log(sqrt(7)) ) + 1;
260             }
261              
262             #------------------------------------------------------------------------------
263             # levels
264              
265             sub level_to_n_range {
266 5     5 1 152 my ($self, $level) = @_;
267 5         19 return (0, 7**$level - 1);
268             }
269             sub n_to_level {
270 0     0 1   my ($self, $n) = @_;
271 0 0         if ($n < 0) { return undef; }
  0            
272 0 0         if (is_infinite($n)) { return $n; }
  0            
273 0           $n = round_nearest($n);
274 0           my ($pow, $exp) = round_up_pow ($n+1, 7);
275 0           return $exp;
276             }
277              
278              
279             #------------------------------------------------------------------------------
280             1;
281             __END__