File Coverage

blib/lib/Math/PlanePath/SquareReplicate.pm
Criterion Covered Total %
statement 77 127 60.6
branch 12 28 42.8
condition 2 9 22.2
subroutine 18 21 85.7
pod 6 6 100.0
total 115 191 60.2


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
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=SquareReplicate --lines --scale=10
20             # math-image --path=SquareReplicate --all --output=numbers_dash --size=80x50
21             # math-image --path=SquareReplicate,numbering_type=rotate-4 --all --output=numbers --size=48x9
22              
23              
24             package Math::PlanePath::SquareReplicate;
25 2     2   8874 use 5.004;
  2         12  
26 2     2   9 use strict;
  2         4  
  2         54  
27              
28 2     2   9 use vars '$VERSION', '@ISA';
  2         4  
  2         104  
29             $VERSION = 127;
30 2     2   658 use Math::PlanePath;
  2         3  
  2         72  
31             @ISA = ('Math::PlanePath');
32              
33             use Math::PlanePath::Base::Generic
34 2         92 'is_infinite',
35 2     2   12 'round_nearest';
  2         4  
36             use Math::PlanePath::Base::Digits
37 2         163 'round_down_pow','round_up_pow',
38 2     2   500 'digit_split_lowtohigh','digit_join_lowtohigh';
  2         4  
39              
40             # uncomment this to run the ### lines
41             # use Smart::Comments;
42              
43              
44 2         128 use constant parameter_info_array =>
45             [ { name => 'numbering_type',
46             display => 'Numbering',
47             type => 'enum',
48             default => 'fixed',
49             choices => ['fixed','rotate-4','rotate-8'],
50             choices_display => ['Fixed','Rotate 4','Rotate 8'],
51             description => 'Fixed or rotating sub-part numbering.',
52             },
53 2     2   12 ];
  2         3  
54              
55 2     2   12 use constant n_start => 0;
  2         4  
  2         106  
56 2     2   10 use constant xy_is_visited => 1;
  2         4  
  2         96  
57 2     2   11 use constant ddiffxy_maximum => 1;
  2         4  
  2         86  
58 2     2   12 use constant dir_maximum_dxdy => (0,-1); # South
  2         2  
  2         109  
59              
60             # these don't vary with numbering_type since initial N=0to9 same
61 2     2   12 use constant x_negative_at_n => 4;
  2         4  
  2         90  
62 2     2   11 use constant y_negative_at_n => 6;
  2         4  
  2         1765  
63              
64             #------------------------------------------------------------------------------
65              
66             sub new {
67 35     35 1 3514 my $self = shift->SUPER::new (@_);
68 35   100     107 $self->{'numbering_type'} ||= 'fixed'; # default
69 35         69 return $self;
70             }
71              
72             sub _digits_rotate_lowtohigh {
73 20535     20535   93624 my ($self, $aref) = @_;
74 20535         27998 my $rot = 0;
75 20535 100       38144 my $mask = ($self->{'numbering_type'} eq 'rotate-4' ? 1 : 0);
76 20535         34119 foreach my $digit (reverse @$aref) {
77 78590 100       132642 if ($digit) {
78 72130         92482 $digit--;
79 72130         99155 my $delta_rot = $digit - ($digit & $mask);
80 72130         99386 $digit = (($digit + $rot) % 8) + 1; # mutate $aref
81 72130         110365 $rot += $delta_rot;
82             }
83             }
84             }
85             sub _digits_unrotate_lowtohigh {
86 13154     13154   765484 my ($self, $aref) = @_;
87             ### _digits_unrotate_lowtohigh(): @$aref
88 13154         18166 my $rot = 0;
89 13154 100       24875 my $mask = ($self->{'numbering_type'} eq 'rotate-4' ? 1 : 0);
90 13154         22190 foreach my $digit (reverse @$aref) {
91             ### at: "digit=$digit rot=$rot"
92 50910 100       86497 if ($digit) {
93 46706         65565 $digit = ($digit-1 - $rot) % 8; # mutate $aref
94             ### new digit 0-based: $digit
95 46706         62727 $rot += $digit - ($digit & $mask);
96             ### $rot
97 46706         70629 $digit++;
98             ### new digit 1-based: $digit
99             }
100             }
101             }
102              
103             # 4 3 2
104             # 5 0 1
105             # 6 7 8
106             #
107             my @digit_to_x = (0,1, 1,0,-1, -1, -1, 0, 1);
108             my @digit_to_y = (0,0, 1,1, 1, 0, -1,-1,-1);
109              
110             sub n_to_xy {
111 7381     7381 1 105087 my ($self, $n) = @_;
112             ### SquareReplicate n_to_xy(): $n
113              
114 7381 50       13728 if ($n < 0) { return; }
  0         0  
115 7381 50       14066 if (is_infinite($n)) { return ($n,$n); }
  0         0  
116              
117             {
118 7381         12276 my $int = int($n);
  7381         10167  
119             ### $int
120             ### $n
121 7381 50       13122 if ($n != $int) {
122 0         0 my ($x1,$y1) = $self->n_to_xy($int);
123 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
124 0         0 my $frac = $n - $int; # inherit possible BigFloat
125 0         0 my $dx = $x2-$x1;
126 0         0 my $dy = $y2-$y1;
127 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
128             }
129 7381         10353 $n = $int; # BigFloat int() gives BigInt, use that
130             }
131              
132 7381         10609 my $x = my $y = ($n * 0); # inherit bignum 0
133 7381         10118 my $len = ($x + 1); # inherit bignum 1
134              
135 7381         14306 my @digits = digit_split_lowtohigh($n,9);
136 7381 50       15767 if ($self->{'numbering_type'} ne 'fixed') {
137 7381         12695 _digits_rotate_lowtohigh($self, \@digits, 1);
138             }
139 7381         12007 foreach my $digit (@digits) {
140             ### at: "$x,$y digit=$digit"
141 27680         37490 $x += $digit_to_x[$digit] * $len;
142 27680         36564 $y += $digit_to_y[$digit] * $len;
143 27680         39679 $len *= 3;
144             }
145             ### final: "$x,$y"
146 7381         16089 return ($x,$y);
147             }
148              
149             # mod digit
150             # 5 3 4 4 3 2 (x mod 3) + 3*(y mod 3)
151             # 2 0 1 5 0 1
152             # 8 6 7 6 7 8
153             #
154             my @mod_to_digit = (0,1,5, 3,2,4, 7,8,6);
155              
156             sub xy_to_n {
157 0     0 1 0 my ($self, $x, $y) = @_;
158             ### SquareReplicate xy_to_n(): "$x, $y"
159              
160 0         0 $x = round_nearest ($x);
161 0         0 $y = round_nearest ($y);
162              
163 0         0 my ($len,$level_limit);
164             {
165 0         0 my $xa = abs($x);
  0         0  
166 0         0 my $ya = abs($y);
167 0   0     0 ($len,$level_limit) = round_down_pow (2*($xa > $ya ? $xa : $ya) || 1, 3);
168             ### $level_limit
169             ### $len
170             }
171 0         0 $level_limit += 2;
172 0 0       0 if (is_infinite($level_limit)) {
173 0         0 return $level_limit;
174             }
175              
176 0         0 my $zero = ($x * 0 * $y); # inherit bignum 0
177 0         0 my @n; # digits low to high
178 0   0     0 while ($x || $y) {
179 0 0       0 if ($level_limit-- < 0) {
180             ### oops, level limit reached ...
181 0         0 return undef;
182             }
183 0         0 my $m = ($x % 3) + 3*($y % 3);
184 0         0 my $digit = $mod_to_digit[$m];
185 0         0 push @n, $digit;
186             ### at: "$x,$y m=$m digit=$digit"
187              
188 0         0 $x -= $digit_to_x[$digit];
189 0         0 $y -= $digit_to_y[$digit];
190             ### subtract: "$digit_to_x[$digit],$digit_to_y[$digit] to $x,$y"
191              
192             ### assert: $x!=$x || $x % 3 == 0
193             ### assert: $y!=$y || $y % 3 == 0
194 0         0 $x /= 3;
195 0         0 $y /= 3;
196             }
197             ### n from xy: @n
198 0 0       0 if ($self->{'numbering_type'} ne 'fixed') {
199 0         0 _digits_rotate_lowtohigh($self, \@n, -1);
200             ### @n
201             }
202 0         0 return digit_join_lowtohigh (\@n, 9, $zero);
203             }
204              
205             # level N Xmax
206             # 1 9^1-1 1
207             # 2 9^2-1 1+3
208             # 3 9^3-1 1+3+9
209             # X <= 3^0+3^1+...+3^(level-1)
210             # X <= 1 + 3^0+3^1+...+3^(level-1)
211             # X <= (3^level - 1)/2
212             # 2*X+1 <= 3^level
213             # level >= log3(2*X+1)
214             #
215             # X < 1 + 3^0+3^1+...+3^(level-1)
216             # X < 1 + (3^level - 1)/2
217             # (3^level - 1)/2 > X-1
218             # 3^level - 1 > 2*X-2
219             # 3^level > 2*X-1
220             #
221             # not exact
222             sub rect_to_n_range {
223 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
224             ### SquareReplicate rect_to_n_range(): "$x1,$y1 $x2,$y2"
225              
226 0         0 my $max = abs(round_nearest($x1));
227 0         0 foreach ($y1, $x2, $y2) {
228 0         0 my $m = abs(round_nearest($_));
229 0 0       0 if ($m > $max) { $max = $m }
  0         0  
230             }
231 0   0     0 my ($pow) = round_down_pow (2*($max||1)-1, 3);
232 0         0 return (0, 9*$pow*$pow - 1); # 9^level-1
233             }
234              
235             #-----------------------------------------------------------------------------
236             # level_to_n_range()
237              
238             # shared by Math::PlanePath::WunderlichMeander and more
239             sub level_to_n_range {
240 5     5 1 129 my ($self, $level) = @_;
241 5         27 return (0, 9**$level - 1);
242             }
243             sub n_to_level {
244 0     0 1   my ($self, $n) = @_;
245 0 0         if ($n < 0) { return undef; }
  0            
246 0 0         if (is_infinite($n)) { return $n; }
  0            
247 0           $n = round_nearest($n);
248 0           my ($pow, $exp) = round_up_pow ($n+1, 9);
249 0           return $exp;
250             }
251              
252             #-----------------------------------------------------------------------------
253             1;
254             __END__