Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Math::Fleximal

by tilly (Archbishop)
on Mar 22, 2001 at 02:36 UTC ( [id://66170]=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info
Description: This was inspired by irritation over Compact MD5 representation. If PHP has a solution, why doesn't Perl?

It is still kind of (OK) very rough.

My thanks to tye for a better name than I thought of.

As always the documentation is in the POD section.

package Math::Fleximal;
$VERSION = 0.01;
use Carp;
use integer;
use strict;

# Only do with positive result!  (Else normalize bombs.)
sub abs_sub_from {
  my $values = (shift)->{values};
  my $decs = (shift)->{values};
  
  foreach my $i (0..$#$decs) {
    $values->[$i] -= $decs->[$i];
  }
}

sub abs_add_to {
  my $values = (shift)->{values};
  my $incs = (shift)->{values};

  foreach my $i (0..$#$incs) {
    $values->[$i] += $incs->[$i];
  }
}

sub add {
  my $self = shift;
  my $sum = $self->dup();
  foreach (@_) {
    $sum = $sum->plus($_);
  }
  return $sum;
}

sub array2hash {
  my %pos;
  $pos{$_[$_]} = $_ foreach 0..$#_;
  return wantarray ? %pos : \%pos;
}

sub base_10 {
  my $self = shift;
  my $proto = __PACKAGE__->new(0);
  return $proto->dup($self)->to_str();
}

sub change_flex {
  my $self = shift;
  my $new_flex = shift;
  my $proto = __PACKAGE__->new($new_flex->[0], $new_flex);
  $proto->dup($self);
}

sub cmp {
  my $self = shift;
  my $other = $self->dup(shift);
  if ($self->{sign} ne $other->{sign}) {
    return "+" eq $self->{sign} ? 1 : -1;
  }
  else {
    return (
      cmp_vec($self->{values}, $other->{values})
        * ("+" eq $self->{sign} ? 1 : -1)
    );
  }
}

sub cmp_vec {
  my $first = shift;
  my $second = shift;
  
  my $cmp = @$first <=> @$second;
  my $i = @$first;
  
  while ($i and not $cmp) {
    $i--;
    $cmp = $first->[$i] <=> $second->[$i];
  }

  return $cmp;
}

sub dup {
  my $self = shift;
  my $copy = bless +{ %$self }, ref($self);
  my $val = @_ ? shift : $self;
  return $copy->set_value($val);
}

sub make_mybase {
  my $self = shift;
  return map $self->dup($_), @_;
}

sub minus {
  my $self = shift;
  my $other = $self->dup(shift);
  $other->{sign} = ("+" eq $other->{sign}) ? "-" : "+";
  return $self->add($other);
}

sub mul {
  my $prod = (shift)->dup();
  foreach (@_) {
    $prod = $prod->times($_);
  }
  return $prod;
}

sub new {
  my $self = bless {sign => '+', value => []}, shift;
  my $value = shift;
  my $flex = $self->{flex} = shift || [0..9];
  $self->{base} = @$flex;
  $self->{match_fleck} = ret_match_any(@$flex);
  $self->{fleck_lookup} = array2hash(@$flex);
  return $self->set_value($value);
}

# values assumed to work out nonnegative
sub normalize {
  my $self = shift;
  my $base = $self->{base};
  my $values = $self->{values};
  
  # We need to have a valid base rep
  my $i = 0;
  my $carry = 0;
  while ($carry or $i < @$values) {
    $carry += $values->[$i];
    while ($carry < 0) {
      $carry += $base;
      $values->[$i + 1]--;
    }
    $values->[$i] = $carry % $base;
    
    $carry /= $base;
    ++$i;
  }
  
  # Deal with leading 0's and 0...
  pop(@$values) while @$values and not $values->[-1];
  $self->{sign} = "+" if not @$values;
  return $self;
}

sub one {
  my $num = (shift)->dup();
  $num->{sign} = "+";
  $num->{values} = [1];
  return $num;
}

sub parse_rep {
  my $self = shift;
  my $str = shift;
  
  $str =~ s/\s//g;
  my $sign = ($str =~ /^([+-])/g) ? $1 : "+";
  
  my @values;
  my $match_fleck = $self->{match_fleck};
  my $fleck_lookup = $self->{fleck_lookup};
  my $last_pos = pos($str);
  
  while ($str =~ /\G($match_fleck)/g) {
    push @values, $fleck_lookup->{$1};
    $last_pos = pos($str);
  }
  
  croak(
    "Cannot find any digits in $str.\n" .
    "Current flex: (@{$self->{flex}})\n"
  ) unless @values;
  
  carp("'$str' truncated in parse")
    unless $last_pos == length($str);
  
  return ($sign, [reverse @values]);
}

sub plus {
  my $self = shift;
  my $other = $self->dup(shift);
  my $sum;
  if ($self->{sign} eq $other->{sign}) {
    $sum = $self->dup();
    abs_add_to($sum, $other);
  }
  elsif (0 < cmp_vec($self->{values}, $other->{values})) {
    $sum = $self->dup();
    $sum->abs_sub_from($other);
  }
  else {
    $sum = $other->dup();
    $sum->abs_sub_from($self);
  }
  return $sum->normalize();
}

sub ret_match_any {
  # Hack to match longest token possible
  my @toks = reverse sort @_;
  my $str = join "|", map quotemeta($_), @_;
  return qr/$str/;
}

sub set_value {
  my $self = shift;
  my $value = shift;
  if (ref($value)) {
    if ($self->{base} == $value->{base}) {
      $self->{values} = [ @{ $value->{values} } ];
    }
    else {
      my $factor = $value->{base};
      my $converted = $self->zero();
      my $scale = $self->one();

      foreach (@{ $value->{values} }) {
        $converted = $converted->plus($scale->times_const($_));
        $scale = $scale->times_const($factor);
      }
      $self->{values} = $converted->{values};
    }
    $self->{sign} = $value->{sign};
  }
  else {
    @$self{'sign', 'values'} = $self->parse_rep($value);
    $self->normalize();
  }
  return $self;
}

sub subtr {
  my $result = (shift)->dup();
  $result = $result->minus($_) foreach @_;
  return $result;
}

sub times {
  my $self = shift;
  my $other = $self->dup(shift);
  
  my $result = $self->zero();
  my @leading_zeros = ();
  
  # Prevents possible sign bug on 0
  unless (@{$self->{values}} and @{$other->{values}}) {
    return $result;
  }
  
  foreach (@{ $other->{values} }) {
    my $tmp = $self->times_const($_);
    unshift @{$tmp->{values}}, @leading_zeros;
    $result = $result->plus($tmp);
    push @leading_zeros, 0;
  }
  
  $result->{sign} =
    ($self->{sign} eq $other->{sign}) ? "+" : "-";

  $result;
}

sub times_const {
  my $result = (shift)->dup();
  my $const = shift;
  if ($const < 0) {
    $const *= -1;
    $result->{sign} =
      ("+" eq $result->{sign}) ?
        "-" : "+";
  }
  foreach my $term (@{$result->{values}}) {
    $term *= $const;
  }
  $result->normalize();
  return $result;
}
    

sub to_str {
  my $self = shift;
  my $flex = $self->{flex};
  my @vals = @{$self->{values}};
  push @vals, 0 unless @vals;
  return join "",
    $self->{sign},
    map $flex->[$_], reverse @vals;
}

sub zero {
  my $num = (shift)->dup();
  $num->{sign} = "+";
  $num->{values} = [];
  return $num;
}

1;

__END__

=head1 NAME

Math::Fleximal - Integers with flexible representations.

=head1 SYNOPSIS

  use Math::Fleximal;
  my $number = new Math::Fleximal($value, $flex);
  
  # Set the value
  $number = $number->set_value("- $fleck_4$fleck_3");
  $number = $number->set_value($another_number);

  # Get the object in a familiar form  
  my $string = $number->to_str();
  my $integer = $number->base_10();
  
  # Construct more numbers with same flex
  my $copy = $number->dup();
  my $other_number = $number->dup($value);

  # New representation anyone?
  my $in_new_base = $number->change_base($new_flex);

  # Arithmetic - can be different flex.  Answers have
  # the flex of $number.
  $result = $number->add($other_number);
  $result = $number->subtr($other_number);
  $result = $number->mul($other_number);
  # Sorry, division not implemented.
  
  my $comparison = $number->cmp($other_number);

=head1 DESCRIPTION

This is a package for doing integer arithmetic while
using a different base representation than normal.  In
base n arithmetic you have n symbols which have a
representation.  I was going to call them "glyphs",
but being text strings they are not really.  On Tye
McQueen's whimsical suggestion I settled on the name 
Math::Fleximal, the set of text representations is 
called a "flex", and the representation of individual 
digits are the "flecks".  These names are somewhat 
unofficial...

This allows you to do basic arithmetic using whatever
digits you want, and to convert from one to another.

Like C<Math::BigInt> it is able to handle very large
numbers, though performance is not very good.  Instead
it is meant to be a version of Math::BaseCalc without
the limit on size of numbers.  Which would be suitable
for representing MD5 hashes in a character set of your
choice.

=over 4

=item C<new>

Construct a new number.  The arguments are the value
and the anonymous array of flecks that make up the
flex.  The flex will default to [0..9].  This can be
used to calculations in bases other than 10 - the base
is just the number of flecks in the flex.  So you could
construct a base 16 number with:

  my $base_16 = new Math::Fleximal("4d", [0..9, 'a'..'f']);

If a value is passed it can be an existing Math::Fleximal
or (as above) a string that can be parsed with the current
flex.

Flecks are assumed to not be ambiguous and not contain
whitespace.

=item C<dup>

Copy an existing number.  This copy may be worked with
without changing the existing number.  If dup is passed
a value, the new instance will have that value instead.

=item C<set_value>

This sets the internal value and returns the object.

You can either pass the new value an existing instance
(which may be in another base) or a string.  When passed
a string it first strips whitespace.  After that it
accepts an optional +-, followed by a series of flecks
(there must be at least one) for the first to last
digits.  It will be confused if the leading fleck starts
with + or - and no sign is included.

=item C<to_str>

Returns the string representation of the current value
using the current flex.  This always includes a sign,
with no white space in front of the sign.

=item C<base_10>

Returns the internal value in a base 10 representation.
The numbers returned may be larger than Perl's usual
integer representation can handle.

=item C<change_flex>

Takes a new flex and converts the current to that.
Will implicitly change base if needed.

=item C<add>

Adds one or more numbers to the current one and returns
the answer in the current flex.  The numbers may be of
any flex, or strings in the current representation.

=item C<subtr>

Subtracts one or more numbers from the current one and
returns the answer in the current flex.  The numbers may
be of any flex, or strings in the current representation.

=item C<mul>

Multiplies one or more numbers to the current one and
returns the answer in the current representation.  The
numbers may be of any flex, or strings of the current
representation.

=item C<cmp>

Pass another number, returns -1 if it is smaller, 0
if they are equal, and 1 if it is larger.

=item C<one>

Returns 1 in the current flex.

=item C<zero>

Returns 0 in the current flex.

=over

=head1 BUGS

Division is not implemented.  Neither is subtraction.

This will fail if you are trying to work in bases of
size more than 30,000 or so.  So Don't Do That. :-)

Flecks should not start with whitespace.

=head1 AUTHOR AND COPYRIGHT

Copyright 2000, Ben Tilly.

Anyone who finds this actually useful may use it on
the same terms as Perl itself.  OK, even if you find
it useless as well...

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://66170]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2024-03-19 07:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found