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   526 use warnings FATAL => qw(all);
  1         3  
  1         42  
11 1     1   6 use strict;
  1         2  
  1         36  
12 1     1   8 use Carp;
  1         3  
  1         74  
13 1     1   860 use Math::BigInt;
  1         31258  
  1         4  
14              
15             our $VERSION = '20170808';
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 1082 {my ($number, $digits) = @_; # Decimal integer, encoding digits
21              
22 387 50       1473 $number =~ m/\A\d+\Z/s or confess "$number is not a positive decimal integer";# Check the number to be encoded
23              
24 387         1350 my @b = split //, $digits; # Check the encoding digits
25 387         1203 my $b = Math::BigInt->new(scalar @b);
26 387 50       14912 $b > 1 or confess
27             "number of encoding digits supplied($b) too few, must be at least 2";
28              
29 387 100       38753 return $b[0] if $number == 0; # A simple case
30              
31 384         880 my $n = Math::BigInt->new($number); # Convert to BigInt
32 384         12432 my $e = ''; # Encoded version
33              
34 384         992 for my $position(0..4*length($number)) # Encoding in binary would take less than this number of digits
35 2668         65153 {my $p = $b ** $position;
36 2668 100       1118390 next if $p < $n;
37 384 100       10365 return $b[1].($b[0] x $position) if $p == $n;
38 372         9346 for my $divide(reverse 0..$position-1)
39 2259         209858 {my $P = $b ** $divide;
40 2259         1099242 my $D = int($n / $P);
41 2259         344143 $e .= $b[$D];
42 2259         46869 $n -= $P*$D;
43             }
44 372         51737 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 620 {my ($number, $digits) = @_; # Number to decode, encoding digits
50              
51 259         868 my @b = split //, $digits;
52 259         463 my $b = @b;
53 259 50       600 $b > 1 or confess
54             "number of decoding digits supplied($b) too few, must be at least 2";
55              
56 259         795 my @n = split //, $number;
57 259         409 my $n = @n;
58              
59 259         651 for(1..$n) # Convert each digit to be decoded with its decimal equivalent
60 2025         2660 {my $d = $n[$_-1];
61 2025         2659 my $i = index($digits, $d);
62 2025 50       3008 $i < 0 and confess "Invalid digit \"$d\" in number $number at position $_";
63 2025         3036 $n[$_-1] = $i;
64             }
65              
66 259         760 my $p = Math::BigInt->new(1);
67 259         9972 my $s = Math::BigInt->new(0);
68 259         21075 for(reverse @n) # Decode each digit
69 2025         217722 {$s += $p * $_;
70 2025         376114 $p *= $b;
71             }
72              
73             "$s"
74 259         28069 }
75              
76             #-------------------------------------------------------------------------------
77             # Export
78             #-------------------------------------------------------------------------------
79              
80             require Exporter;
81              
82 1     1   17911 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         171  
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 but should
109             be placed inside strings to avoid inadvertent truncation.
110              
111             my $n = '1'.('0'x999).'1';
112              
113             my $d = Encode::Positive::Digits::decode($n, "01");
114             my $e = Encode::Positive::Digits::encode($d, "01");
115              
116             ok $n == $e
117              
118             ok length($d) == 302;
119             ok length($e) == 1001;
120             ok length($n) == 1001;
121              
122             =head1 Description
123              
124             =head2 Encode and decode
125              
126             =head3 encode
127              
128             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.
129              
130             1 $number Decimal integer
131             2 $digits Encoding digits
132              
133             =head3 decode
134              
135             Return the integer expressed in decimal notation corresponding to the value of the specified string considered as a number over the specified digits
136              
137             1 $number Number to decode
138             2 $digits Encoding digits
139              
140              
141             =head1 Index
142              
143              
144             L
145              
146             L
147              
148             =head1 Installation
149              
150             This module is written in 100% Pure Perl and, thus, it is easy to read, use,
151             modify and install.
152              
153             Standard Module::Build process for building and installing modules:
154              
155             perl Build.PL
156             ./Build
157             ./Build test
158             ./Build install
159              
160             =head1 Author
161              
162             L
163              
164             L
165              
166             =head1 Copyright
167              
168             Copyright (c) 2016-2017 Philip R Brenan.
169              
170             This module is free software. It may be used, redistributed and/or modified
171             under the same terms as Perl itself.
172              
173             =cut
174              
175              
176             # Tests and documentation
177              
178             sub test
179 1     1 0 9 {my $p = __PACKAGE__;
180 1 50       57 return if eval "eof(${p}::DATA)";
181 1         43 my $s = eval "join('', <${p}::DATA>)";
182 1 50       4 $@ and die $@;
183 1     1   363 eval $s;
  1         43596  
  1         8  
  1         49  
184 1 50       261 $@ and die $@;
185             }
186              
187             test unless caller;
188              
189             1;
190             # podDocumentation
191             __DATA__