File Coverage

blib/lib/Math/NumSeq/HafermanCarpet.pm
Criterion Covered Total %
statement 71 79 89.8
branch 15 24 62.5
condition 7 16 43.7
subroutine 16 16 100.0
pod 2 2 100.0
total 111 137 81.0


line stmt bran cond sub pod time code
1             # Copyright 2013, 2014 Kevin Ryde
2              
3             # This file is part of Math-NumSeq.
4             #
5             # Math-NumSeq 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-NumSeq 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-NumSeq. If not, see .
17              
18              
19             package Math::NumSeq::HafermanCarpet;
20 2     2   7149 use 5.004;
  2         5  
21 2     2   7 use strict;
  2         2  
  2         45  
22              
23 2     2   7 use vars '$VERSION', '@ISA';
  2         2  
  2         102  
24             $VERSION = 72;
25              
26 2     2   341 use Math::NumSeq;
  2         3  
  2         45  
27 2     2   327 use Math::NumSeq::Base::IterateIth;
  2         3  
  2         71  
28             @ISA = ('Math::NumSeq::Base::IterateIth',
29             'Math::NumSeq');
30             *_is_infinite = \&Math::NumSeq::_is_infinite;
31              
32 2     2   329 use Math::NumSeq::Repdigits;
  2         2  
  2         73  
33             *_digit_split_lowtohigh = \&Math::NumSeq::Repdigits::_digit_split_lowtohigh;
34              
35             # uncomment this to run the ### lines
36             # use Smart::Comments;
37              
38              
39 2     2   7 use constant description => Math::NumSeq::__('Flattened Haferman carpet.');
  2         2  
  2         5  
40 2     2   10 use constant default_i_start => 0;
  2         3  
  2         88  
41 2     2   6 use constant values_min => 0;
  2         2  
  2         75  
42 2     2   7 use constant values_max => 1;
  2         2  
  2         72  
43 2     2   7 use constant characteristic_integer => 1;
  2         3  
  2         111  
44 2     2   7 use constant characteristic_smaller => 1;
  2         2  
  2         136  
45              
46             # 000 all zeros
47             # 001 infs are box fractal
48             # 010 evens is plain starting from 1
49             # 011 odd=1 even=0 inf=0 is inverse of plain
50             # 100 odds odd=0 even=1 inf=1 is plain starting from 0
51             # 101 inverse of evens
52             # 110 inverse of infs box fractal
53             # 111 all ones
54              
55             # start0 carpet 0
56             # start0 inv carpet 0 inverse
57             # start1 carpet 1
58             # start1 inv carpet 1 inverse
59             # box
60             # box inverse
61              
62 2         8 use constant parameter_info_array =>
63             [
64             # { name => 'haferman_type',
65             # display => Math::NumSeq::__('Type'),
66             # type => 'enum',
67             # default => 'array',
68             # choices => ['array','alt','side'],
69             # },
70             { name => 'initial_value',
71             display => Math::NumSeq::__('Initial'),
72             type => 'integer',
73             default => 0,
74             minimum => 0,
75             maximum => 1,
76             width => 1,
77             },
78             { name => 'inverse',
79             display => Math::NumSeq::__('Inverse'),
80             type => 'boolean',
81             default => 0,
82             },
83             # { name => 'radix',
84             # share_key => 'radix_3',
85             # type => 'integer',
86             # display => Math::NumSeq::__('Radix'),
87             # default => 3,
88             # minimum => 2,
89             # width => 3,
90             # description => Math::NumSeq::__('Radix, ie. base, for the values calculation. Default is base 3.'),
91             # },
92 2     2   6 ];
  2         2  
93              
94             #------------------------------------------------------------------------------
95              
96             # 000 all zeros
97             # 001 infs are box fractal
98             # 010 evens inverse of starting from 1
99             # 011 odd=1 even=0 inf=0 is inverse of plain
100             # 100 odds odd=0 even=1 inf=1 is plain starting from 0
101             # 101 is plain starting from 1
102             # 110 inverse of infs box fractal
103             # 111 all ones
104             #
105             # my %odd_by_type = (start0 => 1,
106             # start1 => 1,
107             # box => 0);
108             # my %inf_by_type = (start0 => 0,
109             # start1 => 1,
110             # box => 1);
111             sub ith {
112 1777     1777 1 1654 my ($self, $i) = @_;
113             ### ith(): $i
114              
115 1777 100 66     3501 if ($i < 0 || _is_infinite($i)) { # don't loop forever if $i is +infinity
116 9         14 return undef;
117             }
118              
119 1768   50     3751 my $haferman_type = $self->{'haferman_type'} || 'array';
120 1768   50     3593 my $radix = $self->{'radix'} || 3;
121 1768         999 my $two_digits;
122 1768 50       1823 if ($haferman_type eq 'array') {
123 1768 50       1664 if ($radix & 1) {
124 1768         1324 $radix *= $radix;
125             } else {
126 0         0 $two_digits = 1;
127             }
128             } else {
129 0         0 $two_digits = ($haferman_type eq 'alt');
130             }
131              
132 1768         1094 my $value = 0; # position even or odd
133 1768         1049 for (;;) {
134 3145 100       2730 if ($i) {
135 2609         2287 my $digit = _divrem_mutate($i,$radix);
136 2609 50       2824 if ($two_digits) {
137 0         0 my $digit2 = _divrem_mutate($i,$radix);
138 0 0       0 if ($haferman_type eq 'array') {
139 0         0 $digit += $digit2;
140             }
141             }
142 2609 100       2378 if ($digit & 1) {
143             # stop at odd digit
144 1232 100       1089 if ($value) {
145 466         283 $value = 0; # even position value=0 always
146             } else {
147 766 50       783 $value = ($haferman_type eq 'box' ? 0 : 1);
148             }
149 1232         846 last;
150             } else {
151             # step position across even digit
152 1377         1021 $value ^= 1;
153             }
154             } else {
155             # no more digits, all even, no odd
156 536         381 $value = $self->{'initial_value'};
157 536         367 last;
158             }
159             }
160 1768 100       2043 if ($self->{'inverse'}) {
161 622         410 $value ^= 1;
162             }
163 1768         3016 return $value;
164             }
165              
166             sub pred {
167 92     92 1 198 my ($self, $value) = @_;
168 92   66     174 return ($value == 0 || $value == 1);
169             }
170              
171             #------------------------------------------------------------------------------
172              
173             # return $remainder, modify $n
174             # the scalar $_[0] is modified, but if it's a BigInt then a new BigInt is made
175             # and stored there, the bigint value is not changed
176             sub _divrem_mutate {
177 2609     2609   1602 my $d = $_[1];
178 2609         1412 my $rem;
179 2609 50 33     3665 if (ref $_[0] && $_[0]->isa('Math::BigInt')) {
180 0         0 ($_[0], $rem) = $_[0]->copy->bdiv($d); # quot,rem in array context
181 0 0 0     0 if (! ref $d || $d < 1_000_000) {
182 0         0 return $rem->numify; # plain remainder if fits
183             }
184             } else {
185 2609         1638 $rem = $_[0] % $d;
186 2609         2409 $_[0] = int(($_[0]-$rem)/$d); # exact division stays in UV
187             }
188 2609         2073 return $rem;
189             }
190              
191             1;
192             __END__