File Coverage

blib/lib/Math/PlanePath/SierpinskiArrowheadCentres.pm
Criterion Covered Total %
statement 119 145 82.0
branch 37 56 66.0
condition 3 9 33.3
subroutine 18 22 81.8
pod 8 8 100.0
total 185 240 77.0


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 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 it
6             # under the terms of the GNU General Public License as published by the Free
7             # 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              
20             # math-image --path=SierpinskiArrowheadCentres --lines --scale=10
21             #
22             # math-image --path=SierpinskiArrowheadCentres --all --output=numbers_dash
23             # math-image --path=SierpinskiArrowheadCentres --all --text --size=80
24              
25              
26             package Math::PlanePath::SierpinskiArrowheadCentres;
27 5     5   9328 use 5.004;
  5         29  
28 5     5   36 use strict;
  5         11  
  5         226  
29              
30             #use List::Util 'max';
31             *max = \&Math::PlanePath::_max;
32              
33 5     5   28 use vars '$VERSION', '@ISA';
  5         10  
  5         374  
34             $VERSION = 127;
35 5     5   683 use Math::PlanePath;
  5         63  
  5         223  
36             @ISA = ('Math::PlanePath');
37              
38             use Math::PlanePath::Base::Generic
39 5         286 'is_infinite',
40 5     5   33 'round_nearest';
  5         10  
41             use Math::PlanePath::Base::Digits
42 5         309 'round_down_pow',
43             'round_up_pow',
44             'digit_split_lowtohigh',
45 5     5   488 'digit_join_lowtohigh';
  5         19  
46              
47             # uncomment this to run the ### lines
48             #use Smart::Comments;
49              
50              
51 5     5   1669 use Math::PlanePath::SierpinskiArrowhead;
  5         13  
  5         315  
52             *parameter_info_array # align parameter
53             = \&Math::PlanePath::SierpinskiArrowhead::parameter_info_array;
54             *new = \&Math::PlanePath::SierpinskiArrowhead::new;
55              
56 5     5   33 use constant n_start => 0;
  5         11  
  5         274  
57 5     5   31 use constant class_y_negative => 0;
  5         11  
  5         603  
58             *x_negative = \&Math::PlanePath::SierpinskiArrowhead::x_negative;
59             {
60             my %x_negative_at_n = (triangular => 2,
61             # right => undef,
62             left => 2,
63             # diagonal => undef,
64             );
65             sub x_negative_at_n {
66 0     0 1 0 my ($self) = @_;
67 0         0 return $x_negative_at_n{$self->{'align'}};
68             }
69             }
70             *x_maximum = \&Math::PlanePath::SierpinskiArrowhead::x_maximum;
71 5     5   36 use constant sumxy_minimum => 0; # triangular X>=-Y
  5         10  
  5         231  
72 5     5   32 use Math::PlanePath::SierpinskiTriangle;
  5         10  
  5         300  
73             *diffxy_maximum = \&Math::PlanePath::SierpinskiTriangle::diffxy_maximum;
74              
75 5     5   46 use constant dy_minimum => -1;
  5         12  
  5         288  
76 5     5   40 use constant dy_maximum => 1;
  5         21  
  5         400  
77             *dx_minimum = \&Math::PlanePath::SierpinskiArrowhead::dx_minimum;
78             *dx_maximum = \&Math::PlanePath::SierpinskiArrowhead::dx_maximum;
79              
80             *_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::SierpinskiArrowhead::_UNDOCUMENTED__dxdy_list; # same
81 5     5   34 use constant _UNDOCUMENTED__dxdy_list_at_n => 15;
  5         11  
  5         5953  
82              
83             *absdx_minimum = \&Math::PlanePath::SierpinskiArrowhead::absdx_minimum;
84             *absdx_maximum = \&Math::PlanePath::SierpinskiArrowhead::absdx_maximum;
85             *dsumxy_minimum = \&Math::PlanePath::SierpinskiArrowhead::dsumxy_minimum;
86             *dsumxy_maximum = \&Math::PlanePath::SierpinskiArrowhead::dsumxy_maximum;
87             sub ddiffxy_minimum {
88 0     0 1 0 my ($self) = @_;
89 0 0       0 return ($self->{'align'} eq 'right' ? -1 : -2);
90             }
91             sub ddiffxy_maximum {
92 0     0 1 0 my ($self) = @_;
93 0 0       0 return ($self->{'align'} eq 'right' ? 1 : 2);
94             }
95             *dir_maximum_dxdy = \&Math::PlanePath::SierpinskiArrowhead::dir_maximum_dxdy;
96              
97             #------------------------------------------------------------------------------
98              
99             # States as multiples of 3 so that state+digit is the lookup for next state
100             # and x,y bit.
101             #
102             # 0 3 6 9 12 15
103             #
104             # 8 0 4 4 0 8
105             # | | |\ |\ \ \
106             # 7-6 1-2 3 5 5 3 2-1 6-7
107             # \ \ | \ | \ | |
108             # 1 5 7 3 2 6 6 2 3 7 5 1
109             # |\ \ |\ \ \ | \ | | |\ | |\
110             # 0 2-3-4 8 6-5-4 0-1 7-8 8-7 1-0 4-5-6 8 4-3-2 0
111              
112             # 15 6 3
113             # 6 0 0 12 12 6
114              
115             # 0,1 0,2 1,2
116              
117             my @next_state = (6,0,15, 12,3,9, # 3,6
118             0,6,12, 15,9,3, # 6,9
119             3,12,6, 9,15,0); # 12,15
120             my @state_to_xbit = (0,1,0, 0,1,0,
121             0,0,1, 1,0,0,
122             0,0,1, 1,0,0); # 12,15
123             my @state_to_ybit = (0,0,1, 1,0,0,
124             0,1,0, 0,1,0,
125             1,0,0, 0,0,1); # 12,15
126              
127             # dx,dy for digit==0 and digit==1 in each stage
128             my @state_to_dx;
129             my @state_to_dy;
130             foreach my $state (0,1, 3,4, 6,7, 9,10, 12,13, 15,16) {
131             $state_to_dx[$state] = $state_to_xbit[$state+1] - $state_to_xbit[$state];
132             $state_to_dy[$state] = $state_to_ybit[$state+1] - $state_to_ybit[$state];
133             }
134              
135             sub n_to_xy {
136 145     145 1 13668 my ($self, $n) = @_;
137             ### SierpinskiArrowheadCentres n_to_xy(): $n
138 145 50       375 if ($n < 0) {
139 0         0 return;
140             }
141 145 50       384 if (is_infinite($n)) {
142 0         0 return ($n,$n);
143             }
144              
145 145         300 my $int = int($n);
146 145         235 $n -= $int; # fraction part
147              
148 145         374 my @digits = digit_split_lowtohigh($int,3);
149 145 100       339 my $state = ($#digits & 1 ? 6 : 0);
150             ### @digits
151             ### $state
152              
153 145         244 my (@x,@y); # bits low to high
154 145         255 my $dirstate = $state ^ 6; # if all digits==2
155              
156 145         317 foreach my $i (reverse 0 .. $#digits) {
157             ### at: "x=".join(',',@x[($i+1)..$#digits])." y=".join(',',@y[($i+1)..$#digits])." apply i=$i state=$state digit=$digits[$i]"
158              
159 671         1108 my $digit = $digits[$i]; # high to low
160 671         916 $state += $digit;
161 671         973 $x[$i] = $state_to_xbit[$state];
162 671         979 $y[$i] = $state_to_ybit[$state];
163 671 100       1184 if ($digit != 2) {
164 447         676 $dirstate = $state; # lowest non-2 digit
165             }
166 671         1067 $state = $next_state[$state];
167             }
168              
169 145         256 my $zero = $int * 0;
170 145         408 my $x = $n*$state_to_dx[$dirstate] + digit_join_lowtohigh(\@x,2,$zero);
171 145         376 my $y = $n*$state_to_dy[$dirstate] + digit_join_lowtohigh(\@y,2,$zero);
172              
173 145 100       476 if ($self->{'align'} eq 'right') {
    100          
    100          
174 9         13 $y += $x;
175             } elsif ($self->{'align'} eq 'left') {
176 9         21 ($x,$y) = (-$y,$x+$y);
177             } elsif ($self->{'align'} eq 'triangular') {
178 118         256 ($x,$y) = ($x-$y,$x+$y);
179             }
180 145         506 return ($x,$y);
181             }
182              
183             sub xy_to_n {
184 36     36 1 3008 my ($self, $x, $y) = @_;
185 36         98 $x = round_nearest ($x);
186 36         76 $y = round_nearest ($y);
187             ### SierpinskiArrowheadCentres xy_to_n(): "$x, $y"
188              
189 36 50       79 if ($y < 0) {
190 0         0 return undef;
191             }
192              
193 36 100       107 if ($self->{'align'} eq 'left') {
    100          
194 9 50       20 if ($x > 0) {
195 0         0 return undef;
196             }
197 9         17 $x = 2*$x + $y; # adjust to triangular style
198              
199             } elsif ($self->{'align'} eq 'triangular') {
200 9 50       24 if (($x%2) != ($y%2)) {
201 0         0 return undef;
202             }
203              
204             } else {
205             # right or diagonal
206 18 50       37 if ($x < 0) {
207 0         0 return undef;
208             }
209 18 100       36 if ($self->{'align'} eq 'right') {
210 9         17 $x = 2*$x - $y;
211             } else { # diagonal
212 9         19 ($x,$y) = ($x-$y, $x+$y);
213             }
214             }
215             ### adjusted xy: "$x,$y"
216              
217              
218 36         95 my ($len, $level) = round_down_pow ($y, 2);
219             ### pow2 round up: ($y + ($y==$x || $y==-$x))
220             ### $len
221             ### $level
222 36         65 $level += 1;
223              
224 36 50       81 if (is_infinite($level)) {
225 0         0 return $level;
226             }
227              
228 36         74 my $n = 0;
229 36         73 while ($level) {
230 60         86 $n *= 3;
231             ### at: "$x,$y level=$level len=$len"
232              
233 60 50 33     276 if ($y < 0 || $x < -$y || $x > $y) {
      33        
234             ### out of range ...
235 0         0 return undef;
236             }
237              
238 60 100       123 if ($y < $len) {
239             ### digit 0, first triangle, no change ...
240              
241             } else {
242 48 100       89 if ($level & 1) {
243             ### odd level ...
244 24 100       42 if ($x > 0) {
245             ### digit 1, right triangle ...
246 12         22 $n += 1;
247 12         17 $y -= $len;
248 12         25 $x = - ($x-$len);
249             ### shift right and mirror to: "$x,$y"
250             } else {
251             ### digit 2, left triangle ...
252 12         19 $n += 2;
253 12         17 $x += 1;
254 12         21 $y -= 2*$len-1;
255             ### shift down to: "$x,$y"
256 12         32 ($x,$y) = ((3*$y-$x)/2, # rotate -120
257             ($x+$y)/-2);
258             ### rotate to: "$x,$y"
259             }
260             } else {
261             ### even level ...
262 24 100       46 if ($x < 0) {
263             ### digit 1, left triangle ...
264 12         17 $n += 1;
265 12         22 $y -= $len;
266 12         19 $x = - ($x+$len);
267             ### shift right and mirror to: "$x,$y"
268             } else {
269             ### digit 2, right triangle ...
270 12         17 $n += 2;
271 12         21 $x -= 1;
272 12         17 $y -= 2*$len-1;
273             ### shift down to: "$x,$y"
274 12         32 ($x,$y) = (($x+3*$y)/-2, # rotate +120
275             ($x-$y)/2);
276             ### now: "$x,$y"
277             }
278             }
279             }
280              
281 60         87 $level--;
282 60         134 $len /= 2;
283             }
284              
285             ### final: "$x,$y with n=$n"
286 36 50 33     112 if ($x == 0 && $y == 0) {
287 36         86 return $n;
288             } else {
289 0         0 return undef;
290             }
291             }
292              
293             # not exact
294             sub rect_to_n_range {
295 45     45 1 3872 my ($self, $x1,$y1, $x2,$y2) = @_;
296             ### SierpinskiArrowheadCentres rect_to_n_range(): "$x1,$y1, $x2,$y2"
297              
298 45         122 $y1 = round_nearest ($y1);
299 45         91 $y2 = round_nearest ($y2);
300 45 50       91 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  0         0  
301              
302 45 100       121 if ($self->{'align'} eq 'diagonal') {
303 9         21 $y2 += max (round_nearest ($x1),
304             round_nearest ($x2));
305             }
306              
307 45 50       92 unless ($y2 >= 0) {
308             ### rect all negative, no N ...
309 0         0 return (1, 0);
310             }
311              
312 45         106 my ($len,$level) = round_down_pow ($y2, 2);
313             ### $y2
314             ### $level
315 45         118 return (0, 3**($level+1) - 1);
316             }
317              
318             #-----------------------------------------------------------------------------
319             # level_to_n_range()
320              
321             # shared by SierpinskiTriangle
322             sub level_to_n_range {
323 8     8 1 613 my ($self, $level) = @_;
324 8         33 my $n_start = $self->n_start;
325 8         28 return ($n_start, $n_start + 3**$level - 1);
326             }
327             sub n_to_level {
328 0     0 1   my ($self, $n) = @_;
329 0           $n = $n - $self->n_start;
330 0 0         if ($n < 0) { return undef; }
  0            
331 0 0         if (is_infinite($n)) { return $n; }
  0            
332 0           $n = round_nearest($n);
333 0           my ($pow, $exp) = round_up_pow ($n+1, 3);
334 0           return $exp;
335             }
336              
337             #-----------------------------------------------------------------------------
338             1;
339             __END__