#!/usr/bin/perl #------------------------------------------------------------------------------- # Encode a positive integer using the specified digits and vice-versa # Philip R Brenan at gmail dot com, Appa Apps Ltd, 2017 #------------------------------------------------------------------------------- # podDocumentation package Encode::Positive::Digits; require v5.16.0; use warnings FATAL => qw(all); use strict; use Carp; use Math::BigInt; our $VERSION = '20170811'; #1 Encode and decode 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. {my ($number, $digits) = @_; # Decimal integer, encoding digits $number =~ m/\A\d+\Z/s or confess "$number is not a positive decimal integer";# Check the number to be encoded my @b = split //, $digits; # Check the encoding digits my $b = Math::BigInt->new(scalar @b); $b > 1 or confess "number of encoding digits supplied($b) too few, must be at least 2"; return $b[0] if $number == 0; # A simple case my $n = Math::BigInt->new($number); # Convert to BigInt my $e = ''; # Encoded version for my $position(0..4*length($number)) # Encoding in binary would take less than this number of digits {my $p = $b ** $position; next if $p < $n; return $b[1].($b[0] x $position) if $p == $n; for my $divide(reverse 0..$position-1) {my $P = $b ** $divide; my $D = int($n / $P); $e .= $b[$D]; $n -= $P*$D; } return $e; } } 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 {my ($number, $digits) = @_; # Number to decode, encoding digits my @b = split //, $digits; my $b = @b; $b > 1 or confess "number of decoding digits supplied($b) too few, must be at least 2"; my @n = split //, $number; my $n = @n; for(1..$n) # Convert each digit to be decoded with its decimal equivalent {my $d = $n[$_-1]; my $i = index($digits, $d); $i < 0 and confess "Invalid digit \"$d\" in number $number at position $_"; $n[$_-1] = $i; } my $p = Math::BigInt->new(1); my $s = Math::BigInt->new(0); for(reverse @n) # Decode each digit {$s += $p * $_; $p *= $b; } "$s" } #------------------------------------------------------------------------------- # Export #------------------------------------------------------------------------------- require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(); %EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]); # podDocumentation =pod =encoding utf-8 =head1 Name Encode::Positive::Digits - Encode a positive integer using the specified digits and vice-versa =head1 Synopsis use Encode::Positive::Digits; ok 101 == Encode::Positive::Digits::encode( "5", "01"); ok 5 == Encode::Positive::Digits::decode("101", "01"); ok "hello world" eq Encode::Positive::Digits::encode(4830138323689, " abcdefghlopqrw"); ok 4830138323689 == Encode::Positive::Digits::decode("hello world", " abcdefghlopqrw"); The numbers to be encoded or decoded can be much greater than 2**64 via support from L, such numbers should be placed inside strings to avoid inadvertent truncation. my $n = '1'.('0'x999).'1'; my $d = Encode::Positive::Digits::decode($n, "01"); my $e = Encode::Positive::Digits::encode($d, "01"); ok $n == $e ok length($d) == 302; ok length($e) == 1001; ok length($n) == 1001; =head1 Description =head2 Encode and decode =head3 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. 1 $number Decimal integer 2 $digits Encoding digits =head3 decode Return the integer expressed in decimal notation corresponding to the value of the specified string considered as a number over the specified digits 1 $number Number to decode 2 $digits Encoding digits =head1 Index L L =head1 Installation This module is written in 100% Pure Perl and, thus, it is easy to read, use, modify and install. Standard Module::Build process for building and installing modules: perl Build.PL ./Build ./Build test ./Build install =head1 Author L L =head1 Copyright Copyright (c) 2016-2017 Philip R Brenan. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =cut # Tests and documentation sub test {my $p = __PACKAGE__; return if eval "eof(${p}::DATA)"; my $s = eval "join('', <${p}::DATA>)"; $@ and die $@; eval $s; $@ and die $@; } test unless caller; 1; # podDocumentation __DATA__ use Test::More tests=>649; if (1) {for my $i(0..127) {my $b = Encode::Positive::Digits::encode($i, "01"); ok $b eq sprintf("%b", $i); ok "$i" eq Encode::Positive::Digits::decode($b, "01"); my $x = Encode::Positive::Digits::encode($i, "0123456789abcdef"); ok $x eq sprintf("%x", $i); ok "$i" eq Encode::Positive::Digits::decode($x, "0123456789abcdef"); ok "$i" eq Encode::Positive::Digits::encode($i, "0123456789"); } } if (1) {ok 101 == Encode::Positive::Digits::encode( "5", "01"); ok 5 == Encode::Positive::Digits::decode("101", "01"); } if (1) {ok 4830138323689 == Encode::Positive::Digits::decode("hello world", " abcdefghlopqrw"); ok "hello world" eq Encode::Positive::Digits::encode(4830138323689, " abcdefghlopqrw"); } if (1) {my $n = '1'.('0'x999).'1'; my $d = Encode::Positive::Digits::decode($n, "01"); my $e = Encode::Positive::Digits::encode($d, "01"); ok length($d) == 302; ok length($e) == 1001; ok length($n) == 1001; ok $d == '10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069377'; ok $n == $e }