File Coverage

blib/lib/Encode/Positive/Digits.pm
Criterion Covered Total %
statement 59 59 100.0
branch 13 20 65.0
condition n/a
subroutine 9 9 100.0
pod 2 3 66.6
total 83 91 91.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #-------------------------------------------------------------------------------
3             # Encode a positive integer using the specified digits and vice-versa
4             # Philip R Brenan at gmail dot com, Appa Apps Ltd, 2017
5             #-------------------------------------------------------------------------------
6             # podDocumentation
7              
8             package Encode::Positive::Digits;
9             require v5.16.0;
10 1     1   416 use warnings FATAL => qw(all);
  1         3  
  1         36  
11 1     1   6 use strict;
  1         2  
  1         30  
12 1     1   6 use Carp;
  1         2  
  1         73  
13 1     1   874 use Math::BigInt;
  1         55184  
  1         7  
14              
15             our $VERSION = '20170811';
16              
17             #1 Encode and decode
18              
19             sub encode($$) # Returns a string which expresses a positive integer in decimal notation as a string using the specified digits. The specified digits can be any characters chosen from the Unicode character set.
20 387     387 1 1430 {my ($number, $digits) = @_; # Decimal integer, encoding digits
21              
22 387 50       2283 $number =~ m/\A\d+\Z/s or confess "$number is not a positive decimal integer";# Check the number to be encoded
23              
24 387         2038 my @b = split //, $digits; # Check the encoding digits
25 387         1683 my $b = Math::BigInt->new(scalar @b);
26 387 50       19233 $b > 1 or confess
27             "number of encoding digits supplied($b) too few, must be at least 2";
28              
29 387 100       52917 return $b[0] if $number == 0; # A simple case
30              
31 384         1522 my $n = Math::BigInt->new($number); # Convert to BigInt
32 384         16960 my $e = ''; # Encoded version
33              
34 384         1506 for my $position(0..4*length($number)) # Encoding in binary would take less than this number of digits
35 2668         101259 {my $p = $b ** $position;
36 2668 100       1684810 next if $p < $n;
37 384 100       14131 return $b[1].($b[0] x $position) if $p == $n;
38 372         14153 for my $divide(reverse 0..$position-1)
39 2259         293428 {my $P = $b ** $divide;
40 2259         1477899 my $D = int($n / $P);
41 2259         481039 $e .= $b[$D];
42 2259         65110 $n -= $P*$D;
43             }
44 372         70490 return $e;
45             }
46             }
47              
48             sub decode($$) # Return the integer expressed in decimal notation corresponding to the value of the specified string considered as a number over the specified digits
49 259     259 1 1011 {my ($number, $digits) = @_; # Number to decode, encoding digits
50              
51 259         1406 my @b = split //, $digits;
52 259         779 my $b = @b;
53 259 50       1000 $b > 1 or confess
54             "number of decoding digits supplied($b) too few, must be at least 2";
55              
56 259         1006 my @n = split //, $number;
57 259         690 my $n = @n;
58              
59 259         1045 for(1..$n) # Convert each digit to be decoded with its decimal equivalent
60 2025         3220 {my $d = $n[$_-1];
61 2025         3276 my $i = index($digits, $d);
62 2025 50       3720 $i < 0 and confess "Invalid digit \"$d\" in number $number at position $_";
63 2025         3823 $n[$_-1] = $i;
64             }
65              
66 259         1126 my $p = Math::BigInt->new(1);
67 259         13618 my $s = Math::BigInt->new(0);
68 259         27892 for(reverse @n) # Decode each digit
69 2025         302590 {$s += $p * $_;
70 2025         538285 $p *= $b;
71             }
72              
73             "$s"
74 259         40579 }
75              
76             #-------------------------------------------------------------------------------
77             # Export
78             #-------------------------------------------------------------------------------
79              
80             require Exporter;
81              
82 1     1   30127 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         4  
  1         302  
83              
84             @ISA = qw(Exporter);
85             @EXPORT = qw();
86             @EXPORT_OK = qw();
87             %EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);
88              
89             # podDocumentation
90             =pod
91              
92             =encoding utf-8
93              
94             =head1 Name
95              
96             Encode::Positive::Digits - Encode a positive integer using the specified digits and vice-versa
97              
98             =head1 Synopsis
99              
100             use Encode::Positive::Digits;
101              
102             ok 101 == Encode::Positive::Digits::encode( "5", "01");
103             ok 5 == Encode::Positive::Digits::decode("101", "01");
104              
105             ok "hello world" eq Encode::Positive::Digits::encode(4830138323689, " abcdefghlopqrw");
106             ok 4830138323689 == Encode::Positive::Digits::decode("hello world", " abcdefghlopqrw");
107              
108             The numbers to be encoded or decoded can be much greater than 2**64 via support
109             from L, such numbers should be placed inside strings to avoid
110             inadvertent truncation.
111              
112             my $n = '1'.('0'x999).'1';
113              
114             my $d = Encode::Positive::Digits::decode($n, "01");
115             my $e = Encode::Positive::Digits::encode($d, "01");
116              
117             ok $n == $e
118              
119             ok length($d) == 302;
120             ok length($e) == 1001;
121             ok length($n) == 1001;
122              
123             =head1 Description
124              
125             =head2 Encode and decode
126              
127             =head3 encode
128              
129             Returns a string which expresses a positive integer in decimal notation as a string using the specified digits. The specified digits can be any characters chosen from the Unicode character set.
130              
131             1 $number Decimal integer
132             2 $digits Encoding digits
133              
134             =head3 decode
135              
136             Return the integer expressed in decimal notation corresponding to the value of the specified string considered as a number over the specified digits
137              
138             1 $number Number to decode
139             2 $digits Encoding digits
140              
141              
142             =head1 Index
143              
144              
145             L
146              
147             L
148              
149             =head1 Installation
150              
151             This module is written in 100% Pure Perl and, thus, it is easy to read, use,
152             modify and install.
153              
154             Standard Module::Build process for building and installing modules:
155              
156             perl Build.PL
157             ./Build
158             ./Build test
159             ./Build install
160              
161             =head1 Author
162              
163             L
164              
165             L
166              
167             =head1 Copyright
168              
169             Copyright (c) 2016-2017 Philip R Brenan.
170              
171             This module is free software. It may be used, redistributed and/or modified
172             under the same terms as Perl itself.
173              
174             =cut
175              
176              
177             # Tests and documentation
178              
179             sub test
180 1     1 0 15 {my $p = __PACKAGE__;
181 1 50       87 return if eval "eof(${p}::DATA)";
182 1         103 my $s = eval "join('', <${p}::DATA>)";
183 1 50       8 $@ and die $@;
184 1     1   540 eval $s;
  1         70904  
  1         11  
  1         89  
185 1 50       270 $@ and die $@;
186             }
187              
188             test unless caller;
189              
190             1;
191             # podDocumentation
192             __DATA__