File Coverage

blib/lib/Math/PlanePath/DigitGroups.pm
Criterion Covered Total %
statement 57 113 50.4
branch 6 36 16.6
condition 10 19 52.6
subroutine 12 17 70.5
pod 4 4 100.0
total 89 189 47.0


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             # math-image --path=DigitGroups --output=numbers_dash
20             # math-image --path=DigitGroups,radix=2 --all --output=numbers
21             #
22             # increment N+1 changes low 01111 to 10000
23             # X bits change 01111 to 000, no carry, decreasing by number of low 1s
24             # Y bits change 011 to 100, plain +1
25             #
26             # cf A084473 binary 0->0000
27             # A088698 binary 1->11
28             # A175047 binary 0000run->0
29             #
30             # G. Cantor, "Ein Beitrag zur Mannigfaltigkeitslehre", Journal für die reine
31             # und angewandte Mathematik (Crelle's Journal), Vol. 84, 242-258, 1878.
32             # http://www.digizeitschriften.de/dms/img/?PPN=PPN243919689_0084&DMDID=dmdlog15
33              
34              
35             package Math::PlanePath::DigitGroups;
36 1     1   1180 use 5.004;
  1         4  
37 1     1   6 use strict;
  1         3  
  1         57  
38             #use List::Util 'max','min';
39             *max = \&Math::PlanePath::_max;
40             *min = \&Math::PlanePath::_min;
41              
42 1     1   9 use vars '$VERSION', '@ISA';
  1         7  
  1         68  
43             $VERSION = 128;
44 1     1   706 use Math::PlanePath;
  1         3  
  1         45  
45             @ISA = ('Math::PlanePath');
46              
47             use Math::PlanePath::Base::Generic
48 1         48 'is_infinite',
49 1     1   7 'round_nearest';
  1         2  
50             use Math::PlanePath::Base::Digits
51 1         77 'parameter_info_array', # "radix" parameter
52             'round_down_pow',
53             'digit_split_lowtohigh',
54 1     1   464 'digit_join_lowtohigh';
  1         3  
55              
56             # uncomment this to run the ### lines
57             #use Smart::Comments;
58              
59              
60 1     1   8 use constant n_start => 0;
  1         2  
  1         51  
61 1     1   6 use constant class_x_negative => 0;
  1         2  
  1         42  
62 1     1   5 use constant class_y_negative => 0;
  1         2  
  1         55  
63             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
64 1     1   5 use constant absdx_minimum => 1;
  1         2  
  1         859  
65              
66             sub _UNDOCUMENTED__turn_any_left_at_n {
67 0     0   0 my ($self) = @_;
68 0         0 return $self->{'radix'} - 1;
69             }
70             sub _UNDOCUMENTED__turn_any_right_at_n {
71 0     0   0 my ($self) = @_;
72 0         0 return $self->{'radix'};
73             }
74             sub _UNDOCUMENTED__turn_any_straight_at_n {
75 0     0   0 my ($self) = @_;
76 0 0       0 if ($self->{'radix'} == 2) { return 274; }
  0         0  
77 0         0 return 1;
78             }
79              
80             #------------------------------------------------------------------------------
81             sub new {
82 2     2 1 78 my $self = shift->SUPER::new(@_);
83              
84 2         11 my $radix = $self->{'radix'};
85 2 50 33     9 if (! defined $radix || $radix <= 2) { $radix = 2; }
  2         4  
86 2         4 $self->{'radix'} = $radix;
87              
88 2         5 return $self;
89             }
90              
91             sub n_to_xy {
92 0     0 1 0 my ($self, $n) = @_;
93             ### DigitGroups n_to_xy(): $n
94 0 0       0 if ($n < 0) {
95 0         0 return;
96             }
97 0 0       0 if (is_infinite($n)) {
98 0         0 return ($n,$n);
99             }
100              
101             # what to do for fractions ?
102             {
103 0         0 my $int = int($n);
  0         0  
104             ### $int
105 0 0       0 if ($n != $int) {
106 0         0 my $frac = $n - $int; # inherit possible BigFloat/BigRat
107             ### $frac
108 0         0 my ($x1,$y1) = $self->n_to_xy($int);
109 0         0 my ($x2,$y2) = $self->n_to_xy($int+1);
110 0         0 my $dx = $x2-$x1;
111 0         0 my $dy = $y2-$y1;
112 0         0 return ($frac*$dx + $x1, $frac*$dy + $y1);
113             }
114 0         0 $n = $int; # BigFloat int() gives BigInt, use that
115             }
116              
117 0         0 my $radix = $self->{'radix'};
118 0         0 my (@x,@y); # digits low to high
119              
120 0 0       0 my @digits = digit_split_lowtohigh($n,$radix)
121             or return (0,0); # if $n==0
122              
123 0         0 DIGITS: for (;;) {
124 0         0 my $digit;
125              
126             # from @digits to @x
127 0         0 do {
128             ### digit to x: $digits[0]
129 0         0 $digit = shift @digits; # $n digits low to high
130 0         0 push @x, $digit;
131 0 0       0 @digits || last DIGITS;
132             } while ($digit); # $digit==0 is separator
133              
134             # from @digits to @y
135 0         0 do {
136 0         0 $digit = shift @digits; # low to high
137             ### digit to y: $digit
138 0         0 push @y, $digit;
139 0 0       0 @digits || last DIGITS;
140             } while ($digit); # $digit==0 is separator
141             }
142              
143 0         0 my $zero = $n * 0; # inherit bignum 0
144 0         0 return (digit_join_lowtohigh (\@x, $radix, $zero),
145             digit_join_lowtohigh (\@y, $radix, $zero));
146             }
147              
148             sub xy_to_n {
149 51     51 1 5155 my ($self, $x, $y) = @_;
150             ### DigitGroups xy_to_n(): "$x, $y"
151              
152 51         139 $x = round_nearest ($x);
153 51         101 $y = round_nearest ($y);
154              
155 51 50       107 if (is_infinite($x)) {
156 0         0 return $x;
157             }
158 51 50       113 if (is_infinite($y)) {
159 0         0 return $y;
160             }
161 51 50 33     170 if ($x < 0 || $y < 0) {
162 0         0 return undef;
163             }
164              
165 51 100 66     115 if ($x == 0 && $y == 0) {
166 1         4 return 0;
167             }
168              
169 50         86 my $radix = $self->{'radix'};
170 50         69 my $zero = ($x * 0 * $y); # inherit bignum 0
171 50         74 my @n; # digits low to high
172              
173 50         117 my @x = digit_split_lowtohigh($x,$radix);
174 50         139 my @y = digit_split_lowtohigh($y,$radix);
175              
176 50   66     133 while (@x || @y) {
177 157         210 my $digit;
178 157         191 do {
179 293   100     619 $digit = shift @x || 0; # low to high
180             ### digit from x: $digit
181 293         681 push @n, $digit;
182             } while ($digit);
183              
184 157         222 do {
185 293   100     601 $digit = shift @y || 0; # low to high
186             ### digit from y: $digit
187 293         763 push @n, $digit;
188             } while ($digit);
189             }
190 50         140 return digit_join_lowtohigh (\@n, $radix, $zero);
191             }
192              
193             # not exact
194             sub rect_to_n_range {
195 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
196             ### DigitGroups rect_to_n_range() ...
197              
198 0 0         if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # x1 smaller
  0            
199 0 0         if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # y1 smaller
  0            
200              
201 0 0 0       if ($y2 < 0 || $x2 < 0) {
202 0           return (1, 0); # rect all negative, no N
203             }
204              
205 0           my $radix = $self->{'radix'};
206              
207 0           my ($power, $lo_level) = round_down_pow (min($x1,$y1), $radix);
208 0 0         if (is_infinite($lo_level)) {
209 0           return (0,$lo_level);
210             }
211              
212 0           ($power, my $hi_level) = round_down_pow (max($x2,$y2), $radix);
213 0 0         if (is_infinite($hi_level)) {
214 0           return (0,$hi_level);
215             }
216              
217 0 0         return ($lo_level == 0 ? 0
218             : ($radix*$radix + 1) * $radix ** (2*$lo_level),
219              
220             ($radix-1)*$radix**(3*$hi_level+2)
221             + $radix**($hi_level+1)
222             - 1);
223             }
224              
225             1;
226             __END__