Perl-Sensitive Sunglasses PerlMonks

### Math::Base - arithmetics with baseX integers (updated)

by shmem (Chancellor)
 on Aug 22, 2017 at 12:19 UTC ( #1197795=CUFP: print w/replies, xml ) Need Help??

Another "Silly use for Perl" entry.

Anonymous Monk asked for a method for incrementing mixed letters and numbers recently, which particular need is satisfied with Math::Base36. Can we do better? I guess, yes.

```use 5.10.0;
use Math::Base;

my \$begin = Math::Base->new(36, 1009, 1); # base, number, is_encoded
my \$end   = Math::Base->new(36, 1020, 1);
my \$c     = Math::Base->new(36, 42);

say \$c->encode(\$_) for \$begin .. \$end;

# 1009
# 100A
# 100B
# 100C
# ...
# 101X
# 101Y
# 101Z
# 1020

# also (with updated code below)
# my \$x = Math::Base->new(36, 46664); # 1008 in base36
# say ++\$x for 0..63; # output same as above

# Arithmetics with different encodings:

\$p = Math::Base->new(8,777,1); # decimal 511
\$z = Math::Base->new(36, 35);  # 'Z' as base36
say \$z * \$p;                   # 42735 (octal)
say \$p * \$z;                   # 'DST' (base36)

# Changing the string representation:

\$s = Math::Base->new(16,18);
say \$s;                        # 12
\$s->rebase(18);
say \$s;                        # 10
\$s += 3;                       # 13
\$s->rebase(2);
say \$s;                        # 10101

# Get decimal value:

\$xyz = Math::Base->new(64, 'XYZabc', 1);
say \$xyz->num;                 # 36013230438

Far from complete, but fun enough yet. For me, that is... ;-)

Update: Below is an updated version which handles negative numbers, implements missing operators and lets you define your own charset for baseX conversion, e.g. to calculate base3 with qw(a b c). Also, a method integer() is added which emulates use integer globally for all calculations, and some utility methods/functions.

```package Math::Base;
use strict; use warnings;

my (%op, %unary, %prefix); # operators, unary ops, prefix ops

BEGIN {
%op = qw(
-  minus
*  mul
/  div
** pow
%  mod
<< left
>> right
x  rep
|  or
&  and
^  xor
~  neg
<=> cmpnum
cmp cmpstr
atan2 atan2_
cos cos_
sin sin_
exp exp_
log log_
int numint
++  incr
--  decr
=   assign
);
}
'""' => \&encode,
'0+' => \&num,
%op
);
\$unary{\$_}++  for qw( ~  cos sin exp log sqrt int );
\$prefix{\$_}++ for qw( atan2 );
my %hash;
my @chars = (0..9,'A'..'Z','a'..'z',map{chr\$_}32..44,46,47,58..64,91..
+96);
my @savechars = @chars;

my \$I = 0; # no integer per default
# encode always uses integer value nontheless

for (keys %op) {
next if /(?:^int|=|\+\+|--)\$/;
my \$op = \$op{\$_};
my \$sub = <<EOH;
sub \$op {
my (\\$self, \\$other, \\$swap) = \@_;
my \\$num = \\$self->[1];
(\\$num,\\$other) = (\\$other,\\$num) if \\$swap;
EOH
if (\$prefix{\$_}) {
\$sub .= "    my \\$res = \$_ \\$num, \\$other;\n";
} elsif (\$unary{\$_}) {
\$sub .=  "    my \\$res = \$_ \\$num;\n";
} else {
\$sub .=  "    my \\$res = \\$num \$_ \\$other;\n";
}
if (/<=>|cmp/) {
\$sub .= "    \\$res;\n}";
} else {
\$sub .= <<EOH;
ref \\$res ? \\$I ? int \\$res : \\$res : bless [\\$self->[0],\\$I ? int
+ \\$res : \\$res];
}
EOH
}
unless (eval "\$sub; 1") {
warn \$sub;
die "eval \$_ => \$op \$@";
}
}

sub incr { \$_[0]->[1]++; }
sub decr { \$_[0]->[1]--; }
sub assign {
\$_[1] // return bless [ @{\$_[0]} ];
die "assign takes a number" unless \$_[1] =~ /^[\d\.-]+\$/;
\$_[0]->[1] = \$_[1];
}

sub import {
shift;
@chars = @_ if @_;
chars(@chars);
}

sub chars {
shift if \$_[0] eq __PACKAGE__ || ref \$_[0] eq __PACKAGE__;
if (@_) {
for(@_) { # no utf8 chars for now
length != 1 and die "length of char \$_ must be 1, aborted"
+;
}
grep /-/, @chars and die "no minus sign allowed in chars, abor
+ted";
@chars = @_;
%hash  = ();
@hash{@chars} = 0..\$#chars;
keys %hash != @chars
and die "duplicate chars in list, aborted";
}
@chars;
}

sub restore { chars @savechars }
sub maxbase { scalar @chars }

sub new {
my (\$class, \$base, \$value, \$encoded) = @_;
\$class = ref \$class if ref \$class;
\$base ||= maxbase;
die "base must be lower than \${\scalar@chars}, aborted"
if \$base > @chars;
die "base must be higher than 1, aborted"
if \$base < 2;
my \$self = bless [\$base, \$value], \$class;
\$self->decode if \$encoded;
\$self;
}

sub rebase {
die "base must be lower than \${\(1+@chars)}, aborted"
if \$_[1] > @chars;
die "base must be higher than 1, aborted"
if \$_[1] < 2;
\$_[0]->[0] = \$_[1];
}

sub base { \$_[0]->[0] }
sub num  { \$_[0]->[1] }
sub numint { int \$_[0]->[1] }

sub integer {
shift if \$_[0] eq __PACKAGE__ || ref \$_[0] eq __PACKAGE__;
\$I = shift if @_;
\$I;
}

sub encode {
my (\$base,\$num) = (\$_[0]->[0], \$_[1] || \$_[0]->[1]);
for(['base',\$base],['number',\$num]) {
die "encode: \$_->[0] '\$_->[1]' is not a number, aborted"
unless \$_->[1] =~ /^[\d\.-]+\$/;
}
die "base must be greater than 1, aborted"
if \$base < 2;
die "base must be lower than \${\scalar@chars}, aborted"
if \$base > @chars;
my \$neg = \$num < 0;
\$num = int abs \$num;
my (\$rem,@ret);
while (\$num) {
push @ret, \$chars[(\$rem = \$num % \$base)];
\$num -= \$rem;
\$num /= \$base;
}
push @ret, '-' if \$neg;
return join( '', reverse @ret) || \$chars[0];
}

sub decode {
shift if \$_[0] eq __PACKAGE__;
my \$self = shift;
\$self = shift if @_; # for \$x->decode([3,'210'])
my (\$base, \$str) = @\$self;
\$base > @chars
and die "decode: not enough chars to decode \$str base \$base, a
+borted";
my %h;
my @c= @chars[0..\$base-1]; # take a subset
@h{@c} = (0..\$#c);
my \$num = 0;
\$num = \$num * \$base + (exists \$h{\$_} ? \$h{\$_} :
die "decode: charset = (@c)\n"
."unknown char '\$_' in \$str, aborted")
for \$str =~ /./g;
\$self->[1] = \$num;
}
1;
__END__

Update: fixed some bugs

I'll eventually make it into a CPAN package proper.

perl -le'print map{pack c,(\$-++?1:13)+ord}split//,ESEL'

Replies are listed 'Best First'.
Re: Math::Base - arithmetics with baseX integers
by no_slogan (Deacon) on Aug 22, 2017 at 14:32 UTC
This is a neat idea, but encode spins forever when \$num is negative and returns an empty string when it's zero. You could do this:
```    my \$val = abs(\$num);
do {
push @ret, \$chars[\$val % \$base];
\$val = int(\$val / \$base);
} while \$val;
push @ret, '-' if \$num < 0;
But '-' is in the @chars array.

What I did is to mimic the behavior of sprintf and hex in encode(), i.e. roll over:

```    \$num = (~abs(\$num))+1 if \$num < 0;

And the return line now reads:

```       return join( '', reverse @ret) || 0;

I've updated the op with the new version. Thanks for your hints!

perl -le'print map{pack c,(\$-++?1:13)+ord}split//,ESEL'
\$num = int \$num;
\$num = (~abs(\$num))+1 if \$num < 0;

You can get the same effect with \$num |= 0; ...but... why? Why would you want two's complement behavior in other bases?

Truncating at \$n bits is mathematically equivalent to:

\$num %= 2 ** \$n;

That's only meaningful for base-2. You can truncate at \$n base-\$b digits using this:

\$num %= \$b ** \$n;

So -1 becomes 999999 in base-10 or 666666 in base-7. If you want, you can pick a big number of digits that still fits in a double-precision float like this:

\$num %= \$base ** int(36.73/log(\$base));

This is one of the reasons why I wrote Far from complete (besides missing pod, tests, you name it.)

The perl builtins suffer from negative integer flaws also. The format %x of sprintf expects a signed an unsigned integer, but nonetheless

```say \$f = sprintf "%x", -15;
say hex \$f;
__END__
fffffffffffffff1
18446744073709551601

on a 64bit system. The object could get a sign flag set by the constructor which is honored by arithmetic operations, but the string representation would be ambiguous anyways if the string has a leading dash.

I'm not sure what to do about that. Perhaps limiting to unsigned integers is the way to go, and encode should croak if the number is negative; don't know yet.

update: unsigned, yes, that's the point; common typo. It is coerced into an unsigned. Thanks Anonymous Monk fo pointing out the glitch.

perl -le'print map{pack c,(\$-++?1:13)+ord}split//,ESEL'
%x is clearly documented as taking an unsigned int in the page you link to.
Re: Math::Base - arithmetics with baseX integers
by hdb (Monsignor) on Aug 22, 2017 at 12:54 UTC

Here is my favorite example:

```use Math::Base;

my \$one = Math::Base->new( 13, 6 );
my \$two = Math::Base->new( 13, 9 );

print "\$one times \$two equals ", \$one*\$two, " base 13.\n";

Perfect for a mathematical challenge on facebook. As is 5 * 6 = 42
:-P

perl -le'print map{pack c,(\$-++?1:13)+ord}split//,ESEL'

Create A New User
Node Status?
node history
Node Type: CUFP [id://1197795]
Front-paged by Arunbear
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (4)
As of 2018-07-22 20:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?

Results (455 votes). Check out past polls.

Notices?