File Coverage

blib/lib/Math/PlanePath/LTiling.pm
Criterion Covered Total %
statement 56 125 44.8
branch 10 54 18.5
condition 1 6 16.6
subroutine 14 19 73.6
pod 8 8 100.0
total 89 212 41.9


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             package Math::PlanePath::LTiling;
20 1     1   7165 use 5.004;
  1         7  
21 1     1   5 use strict;
  1         1  
  1         26  
22 1     1   5 use Carp 'croak';
  1         2  
  1         63  
23             #use List::Util 'max';
24             *max = \&Math::PlanePath::_max;
25              
26 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         50  
27             $VERSION = 128;
28 1     1   521 use Math::PlanePath;
  1         2  
  1         40  
29             @ISA = ('Math::PlanePath');
30             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
31              
32             use Math::PlanePath::Base::Generic
33 1         40 'is_infinite',
34 1     1   5 'round_nearest';
  1         1  
35             use Math::PlanePath::Base::Digits
36 1         60 'round_down_pow',
37             'round_up_pow',
38 1     1   371 'digit_split_lowtohigh';
  1         2  
39              
40              
41             # uncomment this to run the ### lines
42             #use Smart::Comments;
43              
44              
45 1     1   5 use constant n_start => 0;
  1         2  
  1         38  
46 1     1   5 use constant class_x_negative => 0;
  1         1  
  1         44  
47 1     1   5 use constant class_y_negative => 0;
  1         1  
  1         61  
48              
49 1         1052 use constant parameter_info_array =>
50             [ { name => 'L_fill',
51             display => 'L Fill',
52             type => 'enum',
53             default => 'middle',
54             choices => ['middle','left','upper','ends','all'],
55             choices_display => ['Middle','Left','Upper','Ends','All'],
56             description => 'Which points to number with each "L".',
57             },
58 1     1   6 ];
  1         1  
59              
60             my %sumxy_minimum = (middle => 0, # X=0,Y=0
61             left => 1, # X=1,Y=0
62             upper => 1, # X=0,Y=1
63             ends => 1, # X=1,Y=0 and X=0,Y=1
64             all => 0, # X=0,Y=0
65             );
66             sub sumxy_minimum {
67 0     0 1 0 my ($self) = @_;
68 0         0 return $sumxy_minimum{$self->{'L_fill'}};
69             }
70             *sumabsxy_minimum = \&sumxy_minimum;
71             *absdiffxy_minimum = \&sumxy_minimum;
72             *rsquared_minimum = \&sumxy_minimum;
73              
74             {
75             my %turn_any_straight = (# middle => 0,
76             left => 1,
77             # upper => 0,
78             ends => 1,
79             all => 1,
80             );
81             sub turn_any_straight {
82 0     0 1 0 my ($self) = @_;
83 0         0 return $turn_any_straight{$self->{'L_fill'}};
84             }
85             }
86              
87             #------------------------------------------------------------------------------
88              
89             sub new {
90 6     6 1 1328 my $self = shift->SUPER::new (@_);
91 6         10 my $L_fill = $self->{'L_fill'};
92 6 100       15 if (! defined $L_fill) {
    50          
93 4         8 $self->{'L_fill'} = 'middle';
94             } elsif (! exists $sumxy_minimum{$L_fill}) {
95 0         0 croak "Unrecognised L_fill option: ",$L_fill;
96             }
97 6         12 return $self;
98             }
99              
100             sub n_to_xy {
101 0     0 1 0 my ($self, $n) = @_;
102             ### LTiling n_to_xy(): $n
103              
104 0 0       0 if ($n < 0) { return; }
  0         0  
105 0 0       0 if (is_infinite($n)) { return ($n,$n); }
  0         0  
106              
107             {
108 0         0 my $int = int($n);
  0         0  
109             ### $int
110             ### $n
111 0 0       0 if ($n != $int) {
112 0         0 my ($x1,$y1) = $self->n_to_xy($int);
113 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
114 0         0 my $frac = $n - $int; # inherit possible BigFloat
115 0         0 my $dx = $x2-$x1;
116 0         0 my $dy = $y2-$y1;
117 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
118             }
119 0         0 $n = $int; # BigFloat int() gives BigInt, use that
120             }
121              
122 0         0 my $x = my $y = ($n * 0); # inherit bignum 0
123 0         0 my $len = $x + 1; # inherit bignum 1
124              
125 0         0 my $L_fill = $self->{'L_fill'};
126 0 0       0 if ($L_fill eq 'left') {
    0          
    0          
    0          
127 0         0 $x += 1;
128             } elsif ($L_fill eq 'upper') {
129 0         0 $y += 1;
130             } elsif ($L_fill eq 'ends') {
131 0         0 my $rem = _divrem_mutate ($n, 2);
132 0 0       0 if ($rem) { # low digit==1
133 0         0 $y = $len; # 1
134             } else { # low digit==0
135 0         0 $x = $len; # 1
136             }
137             } elsif ($L_fill eq 'all') {
138 0         0 my $rem = _divrem_mutate ($n, 3);
139 0 0       0 if ($rem == 1) {
    0          
140 0         0 $x = $len; # 1
141             } elsif ($rem == 2) {
142 0         0 $y = $len; # 1
143             }
144             }
145              
146 0         0 foreach my $digit (digit_split_lowtohigh($n,4)) {
147             ### at: "$x,$y digit=$digit"
148              
149 0 0       0 if ($digit == 1) {
    0          
    0          
150 0         0 ($x,$y) = (4*$len-1-$y,$x);
151             } elsif ($digit == 2) {
152 0         0 $x += $len;
153 0         0 $y += $len;
154             } elsif ($digit == 3) {
155 0         0 ($x,$y) = ($y,4*$len-1-$x);
156             }
157 0         0 $len *= 2;
158             }
159              
160             ### final: "$x,$y"
161 0         0 return ($x,$y);
162             }
163              
164             my @yx_to_digit = ([0,0,1,1],
165             [0,2,2,1],
166             [3,2],
167             [3,3]);
168             my %fill_factor = (middle => 1,
169             left => 1,
170             upper => 1,
171             ends => 2,
172             all => 3);
173             my %yx_to_fill = (middle => [[0]],
174             left => [[undef,0]],
175             upper => [[],
176             [0]],
177             ends => [[undef,0],
178             [1]],
179             all => [[0,1],
180             [2]]);
181             sub xy_to_n {
182 51     51 1 10288 my ($self, $x, $y) = @_;
183             ### LTiling xy_to_n(): "$x, $y"
184              
185 51         106 $x = round_nearest ($x);
186 51         77 $y = round_nearest ($y);
187 51 50 33     159 if ($x < 0 || $y < 0) {
188 0         0 return undef;
189             }
190              
191 51         99 my ($len, $level) = round_down_pow (max($x,$y),
192             2);
193 51 50       94 if (is_infinite($level)) {
194 0         0 return $level;
195             }
196              
197 51         84 my $n = ($x * 0 * $y); # inherit bignum 0
198              
199 51         84 while ($level-- >= 0) {
200             ### assert: $x >= 0
201             ### assert: $y >= 0
202             ### assert: ($y < 2*$len && $x < 4*$len) || ($x < 2*$len && $y < 4*$len)
203              
204             ### $len
205             ### x: int($x/$len)
206             ### y: int($y/$len)
207              
208 244         334 my $digit = $yx_to_digit[int($y/$len)]->[int($x/$len)];
209 244 50       396 if ($digit == 1) {
    100          
    50          
210 0         0 ($x,$y) = ($y,4*$len-1-$x);
211             } elsif ($digit == 2) {
212 136         146 $x -= $len;
213 136         140 $y -= $len;
214             } elsif ($digit == 3) {
215 0         0 ($x,$y) = (4*$len-1-$y,$x);
216             }
217              
218             ### to: "digit=$digit xy=$x,$y"
219              
220 244         249 $n = $n*4 + $digit;
221 244         352 $len /= 2;
222             }
223              
224             ### assert: ($x==0 && $y== 0) || ($x==1 && $y== 0) || ($x==0 && $y== 1)
225              
226 51         69 my $fill = $self->{'L_fill'};
227 51 50       88 if (defined (my $digit = $yx_to_fill{$fill}->[$y]->[$x])) {
228 51         107 return $n*$fill_factor{$fill} + $digit;
229             }
230 0         0 return undef;
231             }
232              
233             my %range_factor = (middle => 3,
234             left => 3,
235             upper => 3,
236             ends => 6,
237             all => 8);
238             # not exact
239             sub rect_to_n_range {
240 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
241             ### LTiling rect_to_n_range(): "$x1,$y1 $x2,$y2"
242              
243 0         0 $x1 = round_nearest ($x1);
244 0         0 $y1 = round_nearest ($y1);
245 0         0 $x2 = round_nearest ($x2);
246 0         0 $y2 = round_nearest ($y2);
247 0 0       0 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
248 0 0       0 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
249             ### rect: "X = $x1 to $x2, Y = $y1 to $y2"
250              
251 0 0 0     0 if ($x2 < 0 || $y2 < 0) {
252             ### rectangle outside first quadrant ...
253 0         0 return (1, 0);
254             }
255              
256 0         0 my ($len, $level) = round_down_pow (max($x2,$y2), 2);
257             ### $len
258             ### $level
259 0 0       0 if (is_infinite($level)) {
260 0         0 return (0,$level);
261             }
262              
263             return (0,
264 0         0 $len*$len * $range_factor{$self->{'L_fill'}});
265             }
266              
267              
268             #------------------------------------------------------------------------------
269             # levels
270              
271             sub level_to_n_range {
272 7     7 1 348 my ($self, $level) = @_;
273 7         23 return (0, 4**$level * $fill_factor{$self->{'L_fill'}} - 1);
274             }
275             sub n_to_level {
276 0     0 1   my ($self, $n) = @_;
277 0 0         if ($n < 0) { return undef; }
  0            
278 0 0         if (is_infinite($n)) { return $n; }
  0            
279 0           $n = round_nearest($n);
280 0           _divrem_mutate ($n, $fill_factor{$self->{'L_fill'}});
281 0           my ($pow, $exp) = round_up_pow ($n+1, 4);
282 0           return $exp;
283             }
284              
285             #------------------------------------------------------------------------------
286             1;
287             __END__