 No such thing as a small change PerlMonks

### Math::Fleximal

by tilly (Archbishop)
 on Mar 22, 2001 at 02:36 UTC 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->, \$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} = ; 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 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 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 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 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 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 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 Takes a new flex and converts the current to that. Will implicitly change base if needed. =item C 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 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 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 Pass another number, returns -1 if it is smaller, 0 if they are equal, and 1 if it is larger. =item C Returns 1 in the current flex. =item C 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... ```

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? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2023-02-01 01:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?