File Coverage

blib/lib/Math/PlanePath/GrayCode.pm
Criterion Covered Total %
statement 99 170 58.2
branch 9 46 19.5
condition 6 48 12.5
subroutine 20 31 64.5
pod 10 10 100.0
total 144 305 47.2


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             # cf. A164677 position of Gray bit change, +/- according to 0->1 or 1->0.
20             # (a signed version of A001511)
21              
22             package Math::PlanePath::GrayCode;
23 3     3   606 use 5.004;
  3         10  
24 3     3   17 use strict;
  3         5  
  3         89  
25 3     3   16 use Carp 'croak';
  3         5  
  3         209  
26             #use List::Util 'max';
27             *max = \&Math::PlanePath::_max;
28              
29 3     3   20 use vars '$VERSION', '@ISA';
  3         6  
  3         193  
30             $VERSION = 128;
31 3     3   684 use Math::PlanePath;
  3         7  
  3         123  
32             @ISA = ('Math::PlanePath');
33              
34             use Math::PlanePath::Base::Generic
35 3         136 'is_infinite',
36 3     3   19 'round_nearest';
  3         6  
37             use Math::PlanePath::Base::Digits
38 3         148 'round_down_pow',
39             'digit_split_lowtohigh',
40 3     3   17 'digit_join_lowtohigh';
  3         6  
41              
42             # uncomment this to run the ### lines
43             #use Smart::Comments;
44              
45              
46 3     3   17 use constant n_start => 0;
  3         6  
  3         170  
47 3     3   19 use constant class_x_negative => 0;
  3         6  
  3         136  
48 3     3   16 use constant class_y_negative => 0;
  3         6  
  3         403  
49             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
50              
51             use constant parameter_info_array =>
52             [
53             { name => 'apply_type',
54             share_key => 'apply_type_TsF',
55             display => 'Apply Type',
56             type => 'enum',
57             default => 'TsF',
58             choices => ['TsF','Ts','Fs','FsT','sT','sF'],
59             choices_display => ['TsF','Ts','Fs','FsT','sT','sF'],
60             description => 'How to apply the Gray coding to/from and split.',
61             },
62             { name => 'gray_type',
63             display => 'Gray Type',
64             type => 'enum',
65             default => 'reflected',
66             choices => ['reflected','modular'],
67             choices_dispaly => ['Reflected','Modular'],
68             description => 'The type of Gray code.',
69             },
70 3         45 { %{Math::PlanePath::Base::Digits::parameter_info_radix2()},
  3         4759  
71             description => 'Radix, for both the Gray code and splitting.',
72             },
73 3     3   19 ];
  3         7  
74              
75             sub _is_peano {
76 0     0   0 my ($self) = @_;
77             return ($self->{'radix'} % 2 == 1
78             && $self->{'gray_type'} eq 'reflected'
79             && ($self->{'apply_type'} eq 'TsF'
80 0   0     0 || $self->{'apply_type'} eq 'FsT'));
81             }
82             sub dx_minimum {
83 0     0 1 0 my ($self) = @_;
84 0 0       0 return (_is_peano($self) ? -1 : undef);
85             }
86             *dy_minimum = \&dx_minimum;
87              
88             sub dx_maximum {
89 0     0 1 0 my ($self) = @_;
90 0 0       0 return (_is_peano($self) ? 1 : undef);
91             }
92             *dy_maximum = \&dx_maximum;
93              
94             {
95             # Ror sT and sF the split X coordinate changes from N to N+1 and so does
96             # the to-gray or from-gray transformation, so X always changes.
97             #
98             my %absdx_minimum = (
99             reflected => {
100             # TsF => 0,
101             # FsT => 0,
102             # Ts => 0,
103             # Fs => 0,
104             sT => 1,
105             sF => 1,
106             },
107             modular => {
108             # TsF => 0,
109             # Ts => 0,
110             Fs => 1,
111             FsT => 1,
112             sT => 1,
113             sF => 1,
114             },
115             );
116             sub absdx_minimum {
117 0     0 1 0 my ($self) = @_;
118             my $gray_type = ($self->{'radix'} == 2
119             ? 'reflected'
120 0 0       0 : $self->{'gray_type'});
121 0   0     0 return ($absdx_minimum{$gray_type}->{$self->{'apply_type'}} || 0);
122             }
123             }
124              
125             *dsumxy_minimum = \&dx_minimum;
126             *dsumxy_maximum = \&dx_maximum;
127             *ddiffxy_minimum = \&dx_minimum;
128             *ddiffxy_maximum = \&dx_maximum;
129              
130             {
131             my %dir_maximum_supremum = (
132             # # radix==2 always "reflected"
133             # # TsF => 0,
134             # # FsT => 0,
135             # # Ts => 0,
136             # # Fs => 0,
137             # sT => 4,
138             # sF => 4,
139              
140             reflected => {
141             # TsF => 0,
142             # FsT => 0,
143             # Ts => 0,
144             # Fs => 0,
145             sT => 4,
146             sF => 4,
147             },
148             modular => {
149             # TsF => 0,
150             # Ts => 0,
151             Fs => 4,
152             FsT => 4,
153             sT => 4,
154             sF => 4,
155             },
156             );
157             sub dir_maximum_dxdy {
158 0     0 1 0 my ($self) = @_;
159             my $gray_type = ($self->{'radix'} == 2
160             ? 'reflected'
161 0 0       0 : $self->{'gray_type'});
162 0 0       0 return ($dir_maximum_supremum{$gray_type}->{$self->{'apply_type'}}
163             ? (0,0) # supremum
164             : (0,-1)); # South
165             }
166             }
167              
168             # radix=2 TsF==Fs is always straight or left
169             sub turn_any_right {
170 0     0 1 0 my ($self) = @_;
171 0 0 0     0 if ($self->{'radix'} == 2
      0        
172             && ($self->{'apply_type'} eq 'TsF'
173             || $self->{'apply_type'} eq 'Fs')) {
174 0         0 return 0; # never right
175             }
176 0         0 return 1;
177             }
178             sub turn_any_straight {
179 0     0 1 0 my ($self) = @_;
180             return ($self->{'radix'} == 2
181 0 0 0     0 && ($self->{'apply_type'} eq 'sT' || $self->{'apply_type'} eq 'sF')
182             ? 0 # never straight
183             : 1);
184             }
185              
186             sub _UNDOCUMENTED__turn_any_left_at_n {
187 0     0   0 my ($self) = @_;
188 0         0 return $self->{'radix'} - 1;
189             }
190             sub _UNDOCUMENTED__turn_any_right_at_n {
191 0     0   0 my ($self) = @_;
192 0 0 0     0 if ($self->{'apply_type'} eq 'TsF' && $self->{'gray_type'} eq 'reflected'
      0        
193             && $self->{'radix'} > 2) {
194 0         0 return 2*$self->{'radix'} - 1;
195             }
196 0         0 return undef;
197             }
198              
199              
200             #------------------------------------------------------------------------------
201             my %funcbase = (T => '_digits_to_gray',
202             F => '_digits_from_gray',
203             '' => '_noop');
204             my %inv = (T => 'F',
205             F => 'T',
206             '' => '');
207              
208             sub new {
209 1     1 1 173 my $self = shift->SUPER::new(@_);
210              
211 1 50 33     29 if (! $self->{'radix'} || $self->{'radix'} < 2) {
212 1         5 $self->{'radix'} = 2;
213             }
214              
215 1   50     9 my $apply_type = ($self->{'apply_type'} ||= 'TsF');
216 1   50     7 my $gray_type = ($self->{'gray_type'} ||= 'reflected');
217              
218 1 50       11 unless ($apply_type =~ /^([TF]?)s([TF]?)$/) {
219 0         0 croak "Unrecognised apply_type \"$apply_type\"";
220             }
221 1         5 my $nf = $1; # "T" or "F" or ""
222 1         5 my $xyf = $2;
223              
224 1   33     17 $self->{'n_func'} = $self->can("$funcbase{$nf}_$gray_type")
225             || croak "Unrecognised gray_type \"$self->{'gray_type'}\"";
226 1         8 $self->{'xy_func'} = $self->can("$funcbase{$xyf}_$gray_type");
227              
228 1         3 $nf = $inv{$nf};
229 1         4 $xyf = $inv{$xyf};
230              
231 1         6 $self->{'inverse_n_func'} = $self->can("$funcbase{$nf}_$gray_type");
232 1         6 $self->{'inverse_xy_func'} = $self->can("$funcbase{$xyf}_$gray_type");
233              
234 1         4 return $self;
235             }
236              
237             sub n_to_xy {
238 4000     4000 1 6215 my ($self, $n) = @_;
239             ### GrayCode n_to_xy(): $n
240              
241 4000 50       7039 if ($n < 0) {
242 0         0 return;
243             }
244 4000 50       7359 if (is_infinite($n)) {
245 0         0 return ($n,$n);
246             }
247              
248             {
249             # ENHANCE-ME: N and N+1 differ by not much ...
250 4000         6515 my $int = int($n);
  4000         5300  
251             ### $int
252 4000 50       7523 if ($n != $int) {
253 0         0 my $frac = $n - $int; # inherit possible BigFloat/BigRat
254             ### $frac
255 0         0 my ($x1,$y1) = $self->n_to_xy($int);
256 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
257 0         0 my $dx = $x2-$x1;
258 0         0 my $dy = $y2-$y1;
259 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
260             }
261 4000         5588 $n = $int; # BigFloat int() gives BigInt, use that
262             }
263              
264 4000         5836 my $radix = $self->{'radix'};
265 4000         7949 my @digits = digit_split_lowtohigh($n,$radix);
266 4000         10299 $self->{'n_func'}->(\@digits, $radix);
267              
268 4000         6319 my @xdigits;
269             my @ydigits;
270 4000         7396 while (@digits) {
271 17310         26845 push @xdigits, shift @digits; # low to high
272 17310   100     45690 push @ydigits, shift @digits || 0;
273             }
274 4000         6014 my $xdigits = \@xdigits;
275 4000         5501 my $ydigits = \@ydigits;
276 4000         8731 $self->{'xy_func'}->($xdigits,$radix);
277 4000         8239 $self->{'xy_func'}->($ydigits,$radix);
278              
279 4000         8144 return (digit_join_lowtohigh($xdigits,$radix),
280             digit_join_lowtohigh($ydigits,$radix));
281             }
282              
283             sub xy_to_n {
284 0     0 1 0 my ($self, $x, $y) = @_;
285             ### GrayCode xy_to_n(): "$x, $y"
286              
287 0         0 $x = round_nearest ($x);
288 0         0 $y = round_nearest ($y);
289 0 0 0     0 if ($x < 0 || $y < 0) {
290 0         0 return undef;
291             }
292 0 0       0 if (is_infinite($x)) {
293 0         0 return $x;
294             }
295 0 0       0 if (is_infinite($y)) {
296 0         0 return $y;
297             }
298              
299 0         0 my $radix = $self->{'radix'};
300 0         0 my @xdigits = digit_split_lowtohigh ($x, $radix);
301 0         0 my @ydigits = digit_split_lowtohigh ($y, $radix);
302              
303 0         0 $self->{'inverse_xy_func'}->(\@xdigits, $radix);
304 0         0 $self->{'inverse_xy_func'}->(\@ydigits, $radix);
305              
306 0         0 my @digits;
307 0         0 for (;;) {
308 0 0 0     0 (@xdigits || @ydigits) or last;
309 0   0     0 push @digits, shift @xdigits || 0;
310 0 0 0     0 (@xdigits || @ydigits) or last;
311 0   0     0 push @digits, shift @ydigits || 0;
312             }
313              
314 0         0 my $digits = \@digits;
315 0         0 $self->{'inverse_n_func'}->($digits,$radix);
316              
317 0         0 return digit_join_lowtohigh($digits,$radix);
318             }
319              
320             # not exact
321             sub rect_to_n_range {
322 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
323              
324 0         0 $x1 = round_nearest($x1);
325 0         0 $y1 = round_nearest($y1);
326 0         0 $x2 = round_nearest($x2);
327 0         0 $y2 = round_nearest($y2);
328              
329 0 0       0 if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # x1 smaller
  0         0  
330 0 0       0 if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # y1 smaller
  0         0  
331              
332 0 0 0     0 if ($y2 < 0 || $x2 < 0) {
333 0         0 return (1, 0); # rect all negative, no N
334             }
335              
336 0         0 my $radix = $self->{'radix'};
337 0         0 my ($pow_max) = round_down_pow (max($x2,$y2), $radix);
338 0         0 $pow_max *= $radix;
339 0         0 return (0, $pow_max*$pow_max - 1);
340             }
341              
342             #------------------------------------------------------------------------------
343              
344 3     3   24 use constant 1.02 _noop_reflected => undef;
  3         45  
  3         199  
345 3     3   20 use constant 1.02 _noop_modular => undef;
  3         37  
  3         1017  
346              
347             # $aref->[0] low digit
348             sub _digits_to_gray_reflected {
349 5159     5159   9699 my ($aref, $radix) = @_;
350             ### _digits_to_gray(): $aref
351 5159         7045 $radix -= 1;
352 5159         6588 my $reverse = 0;
353 5159         8892 foreach my $digit (reverse @$aref) { # high to low
354 35753 100       57546 if ($reverse & 1) {
355 17249         23556 $digit = $radix - $digit; # radix-1 - digit
356             }
357 35753         53080 $reverse ^= $digit;
358             }
359             }
360             # $aref->[0] low digit
361             sub _digits_to_gray_modular {
362 1231     1231   3727 my ($aref, $radix) = @_;
363 1231         1646 my $prev = 0;
364 1231         1995 foreach my $digit (reverse @$aref) { # high to low
365 3914         7129 ($digit,$prev) = (($digit - $prev) % $radix, # mutate $aref->[i]
366             $digit);
367             }
368             }
369              
370             # $aref->[0] low digit
371             sub _digits_from_gray_reflected {
372 9159     9159   15384 my ($aref, $radix) = @_;
373 9159         11669 $radix -= 1; # radix-1
374 9159         12130 my $reverse = 0;
375 9159         13568 foreach my $digit (reverse @$aref) { # high to low
376 38391 100       56714 if ($reverse & 1) {
377 15489         18971 $reverse ^= $digit; # before this reversal
378 15489         22726 $digit = $radix - $digit; # radix-1 - digit, mutate array
379             } else {
380 22902         33467 $reverse ^= $digit;
381             }
382             }
383             }
384             # $aref->[0] low digit
385             sub _digits_from_gray_modular {
386 1231     1231   3639 my ($aref, $radix) = @_;
387             ### _digits_from_gray_modular(): $aref
388              
389 1231         1636 my $offset = 0;
390 1231         2055 foreach my $digit (reverse @$aref) { # high to low
391 3914         6497 $offset = ($digit = ($digit + $offset) % $radix); # mutate $aref->[i]
392             }
393             }
394              
395             #------------------------------------------------------------------------------
396             # levels
397              
398 3     3   1710 use Math::PlanePath::ZOrderCurve;
  3         7  
  3         263  
399             *level_to_n_range = \&Math::PlanePath::ZOrderCurve::level_to_n_range;
400             *n_to_level = \&Math::PlanePath::ZOrderCurve::n_to_level;
401              
402             #------------------------------------------------------------------------------
403             1;
404             __END__