File Coverage

blib/lib/Math/PlanePath/DragonRounded.pm
Criterion Covered Total %
statement 144 159 90.5
branch 23 30 76.6
condition 2 2 100.0
subroutine 27 30 90.0
pod 8 8 100.0
total 204 229 89.0


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=DragonRounded --lines --scale=10
20             # math-image --path=DragonRounded,arms=4 --all --output=numbers_dash --size=132x60
21             #
22              
23              
24             package Math::PlanePath::DragonRounded;
25 1     1   1470 use 5.004;
  1         4  
26 1     1   5 use strict;
  1         2  
  1         47  
27             #use List::Util 'min','max';
28             *min = \&Math::PlanePath::_min;
29             *max = \&Math::PlanePath::_max;
30              
31 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         58  
32             $VERSION = 129;
33 1     1   868 use Math::PlanePath;
  1         2  
  1         54  
34             @ISA = ('Math::PlanePath');
35             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
36              
37             use Math::PlanePath::Base::Generic
38 1         46 'is_infinite',
39             'round_nearest',
40 1     1   8 'floor';
  1         2  
41             use Math::PlanePath::Base::Digits
42 1     1   623 'round_up_pow';
  1         2  
  1         55  
43 1     1   721 use Math::PlanePath::DragonMidpoint;
  1         3  
  1         31  
44              
45             # uncomment this to run the ### lines
46             #use Smart::Comments;
47              
48              
49 1     1   7 use constant n_start => 0;
  1         2  
  1         71  
50 1         120 use constant parameter_info_array => [ { name => 'arms',
51             share_key => 'arms_4',
52             display => 'Arms',
53             type => 'integer',
54             minimum => 1,
55             maximum => 4,
56             default => 1,
57             width => 1,
58             description => 'Arms',
59 1     1   6 } ];
  1         2  
60              
61             {
62             my @x_negative_at_n = (undef, 8,5,2,2);
63             sub x_negative_at_n {
64 0     0 1 0 my ($self) = @_;
65 0         0 return $x_negative_at_n[$self->{'arms'}];
66             }
67             }
68             {
69             my @y_negative_at_n = (undef, 26,17,8,3);
70             sub y_negative_at_n {
71 0     0 1 0 my ($self) = @_;
72 0         0 return $y_negative_at_n[$self->{'arms'}];
73             }
74             }
75 1     1   7 use constant sumabsxy_minimum => 1;
  1         2  
  1         46  
76 1     1   6 use constant absdiffxy_minimum => 1; # X=Y doesn't occur
  1         2  
  1         41  
77 1     1   6 use constant rsquared_minimum => 1; # minimum X=1,Y=0
  1         2  
  1         71  
78              
79 1     1   6 use constant dx_minimum => -1;
  1         2  
  1         51  
80 1     1   7 use constant dx_maximum => 1;
  1         2  
  1         63  
81 1     1   6 use constant dy_minimum => -1;
  1         2  
  1         65  
82 1     1   7 use constant dy_maximum => 1;
  1         2  
  1         88  
83             *_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::_UNDOCUMENTED__dxdy_list_eight;
84 1     1   7 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         43  
85 1     1   6 use constant dsumxy_maximum => 2;
  1         1  
  1         52  
86 1     1   7 use constant ddiffxy_minimum => -2;
  1         1  
  1         56  
87 1     1   6 use constant ddiffxy_maximum => 2;
  1         2  
  1         56  
88 1     1   6 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         3  
  1         72  
89 1     1   6 use constant turn_any_straight => 0; # never straight
  1         66  
  1         942  
90              
91              
92             #------------------------------------------------------------------------------
93              
94             sub new {
95 17     17 1 1948 my $self = shift->SUPER::new(@_);
96 17   100     85 $self->{'arms'} = max(1, min(4, $self->{'arms'} || 1));
97 17         47 return $self;
98             }
99              
100             sub n_to_xy {
101 241     241 1 19702 my ($self, $n) = @_;
102             ### DragonRounded n_to_xy(): $n
103              
104 241 50       562 if ($n < 0) { return; }
  0         0  
105 241 50       604 if (is_infinite($n)) { return ($n, $n); }
  0         0  
106              
107 241         405 my $frac;
108             {
109 241         382 my $int = int($n);
  241         356  
110 241         358 $frac = $n - $int;
111 241         353 $n = $int; # BigFloat int() gives BigInt, use that
112             }
113             ### $frac
114              
115 241         356 my $zero = ($n * 0); # inherit bignum 0
116              
117             # arm as initial rotation
118 241         652 my $rot = _divrem_mutate ($n, $self->{'arms'});
119              
120             # two points per edge
121 241         454 my $x_offset = _divrem_mutate ($n, 2);
122              
123             # ENHANCE-ME: sx,sy just from len=3*2**level
124 241         510 my @digits;
125             my @sx;
126 241         0 my @sy;
127             {
128 241         288 my $sx = $zero + 3;
  241         340  
129 241         363 my $sy = $zero;
130 241         450 while ($n) {
131 1818         2487 push @digits, ($n % 2);
132 1818         2455 push @sx, $sx;
133 1818         2386 push @sy, $sy;
134 1818         2493 $n = int($n/2);
135              
136             # (sx,sy) + rot+90(sx,sy)
137 1818         3334 ($sx,$sy) = ($sx - $sy,
138             $sy + $sx);
139             }
140             }
141              
142             ### @digits
143 241         332 my $rev = 0;
144 241         316 my $x = $zero;
145 241         327 my $y = $zero;
146 241         319 my $above_low_zero = 0;
147              
148 241         527 for (my $i = $#digits; $i >= 0; $i--) { # high to low
149 1818         2452 my $digit = $digits[$i];
150 1818         2385 my $sx = $sx[$i];
151 1818         2317 my $sy = $sy[$i];
152             ### at: "$x,$y $digit side $sx,$sy"
153             ### $rot
154              
155 1818 100       2977 if ($rot & 2) {
156 828         1269 ($sx,$sy) = (-$sx,-$sy);
157             }
158 1818 100       2935 if ($rot & 1) {
159 887         1343 ($sx,$sy) = (-$sy,$sx);
160             }
161             ### rotated side: "$sx,$sy"
162              
163 1818 100       2743 if ($rev) {
164 886 100       1275 if ($digit) {
165 434         565 $x += -$sy;
166 434         799 $y += $sx;
167             ### rev add to: "$x,$y next is still rev"
168             } else {
169 452         651 $above_low_zero = $digits[$i+1];
170 452         634 $rot ++;
171 452         859 $rev = 0;
172             ### rev rot, next is no rev ...
173             }
174             } else {
175 932 100       1365 if ($digit) {
176 550         677 $rot ++;
177 550         764 $x += $sx;
178 550         694 $y += $sy;
179 550         1016 $rev = 1;
180             ### plain add to: "$x,$y next is rev"
181             } else {
182 382         737 $above_low_zero = $digits[$i+1];
183             }
184             }
185             }
186              
187             # Digit above the low zero is the direction of the next turn, 0 for left,
188             # 1 for right, and that determines the y_offset to apply to go across
189             # towards the next edge. When original input $n is odd, which means
190             # $x_offset 0 at this point, there's no y_offset as going along the edge
191             # not across the vertex.
192             #
193 241 100       444 my $y_offset = ($x_offset ? ($above_low_zero ? -$frac : $frac)
    100          
194             : 0);
195 241         417 $x_offset = $frac + 1 + $x_offset;
196              
197             ### final: "$x,$y rot=$rot above_low_zero=$above_low_zero offset=$x_offset,$y_offset"
198 241 100       403 if ($rot & 2) {
199 108         175 ($x_offset,$y_offset) = (-$x_offset,-$y_offset); # rotate 180
200             }
201 241 100       427 if ($rot & 1) {
202 118         207 ($x_offset,$y_offset) = (-$y_offset,$x_offset); # rotate +90
203             }
204 241         334 $x = $x_offset + $x;
205 241         336 $y = $y_offset + $y;
206             ### rotated offset: "$x_offset,$y_offset return $x,$y"
207 241         717 return ($x,$y);
208             }
209              
210             my @yx_rtom_dx = ([undef, 1, 1, undef, 1, 1],
211             [ 0, undef, undef, 1, undef, undef],
212             [ 0, undef, undef, 1, undef, undef],
213             [undef, 1, 1, undef, 1, 1],
214             [ 1, undef, undef, 0, undef, undef],
215             [ 1, undef, undef, 0, undef, undef]);
216              
217             my @yx_rtom_dy = ([undef, 0, 0, undef, -1, -1],
218             [ 0, undef, undef, 0, undef, undef],
219             [ 0, undef, undef, 0, undef, undef],
220             [undef, -1, -1, undef, 0, 0],
221             [ 0, undef, undef, 0, undef, undef],
222             [ 0, undef, undef, 0, undef, undef]);
223              
224             sub xy_to_n {
225 279     279 1 8690 my ($self, $x, $y) = @_;
226             ### DragonRounded xy_to_n(): "$x, $y"
227              
228 279         607 $x = round_nearest($x);
229 279         544 $y = round_nearest($y);
230              
231 279         442 my $x6 = $x % 6;
232 279         369 my $y6 = $y % 6;
233 279 100       441 my $dx = $yx_rtom_dx[$y6][$x6]; defined $dx or return undef;
  279         543  
234 199 50       331 my $dy = $yx_rtom_dy[$y6][$x6]; defined $dy or return undef;
  199         354  
235              
236             # my $n = $self->Math::PlanePath::DragonMidpoint::xy_to_n
237             # ($x - floor($x/3) - $dx,
238             # $y - floor($y/3) - $dy);
239             # ### dxy: "$dx, $dy"
240             # ### to: ($x - floor($x/3) - $dx).", ".($y - floor($y/3) - $dy)
241             # ### $n
242              
243 199         511 return $self->Math::PlanePath::DragonMidpoint::xy_to_n
244             ($x - floor($x/3) - $dx,
245             $y - floor($y/3) - $dy);
246             }
247              
248             # level 21 n=1048576 .. 2097152
249             # min 1052677 0b100000001000000000101 at -1026,1 factor 1.99610706057474
250             # n=2^20 min r^2=2^20 plus a bit
251             # maybe ...
252             #
253             # not exact
254             sub rect_to_n_range {
255 147     147 1 13338 my ($self, $x1,$y1, $x2,$y2) = @_;
256             ### DragonRounded rect_to_n_range(): "$x1,$y1 $x2,$y2 arms=$self->{'arms'}"
257              
258 147         267 $x1 = abs($x1);
259 147         192 $x2 = abs($x2);
260 147         219 $y1 = abs($y1);
261 147         193 $y2 = abs($y2);
262 147         383 my $xmax = int(max($x1,$x2) / 3);
263 147         293 my $ymax = int(max($y1,$y2) / 3);
264             return (0,
265 147         447 ($xmax*$xmax + $ymax*$ymax + 1) * $self->{'arms'} * 16);
266             }
267              
268             #------------------------------------------------------------------------------
269              
270             # each 2 points is a line segment, so 2*DragonMidpoint
271             # level 0 0--1
272             # level 1 0--1 2--3
273             # level 2 0--1 2--3 4--5 6--7
274             #
275             # arms=4
276             # level 0 0--3 / 1--4 / 2--5 / 3--7
277             # level 1
278             #
279             # 2^level segments
280             # 2*2^level rounded points
281             # arms*2^level when multi-arm
282             # numbered starting 0
283             #
284             sub level_to_n_range {
285 5     5 1 310 my ($self, $level) = @_;
286 5         20 return (0, 2**($level+1) * $self->{'arms'} - 1);
287             }
288              
289             sub n_to_level {
290 0     0 1   my ($self, $n) = @_;
291 0 0         if ($n < 0) { return undef; }
  0            
292 0 0         if (is_infinite($n)) { return $n; }
  0            
293 0           $n = round_nearest($n);
294 0           _divrem_mutate ($n, 2*$self->{'arms'});
295 0           my ($pow, $exp) = round_up_pow ($n+1, 2);
296 0           return $exp;
297             }
298              
299             #------------------------------------------------------------------------------
300             1;
301             __END__