You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
155 lines
4.5 KiB
155 lines
4.5 KiB
package bigrat;
|
|
require "bigint.pl";
|
|
#
|
|
# This library is no longer being maintained, and is included for backward
|
|
# compatibility with Perl 4 programs which may require it.
|
|
#
|
|
# In particular, this should not be used as an example of modern Perl
|
|
# programming techniques.
|
|
#
|
|
# Arbitrary size rational math package
|
|
#
|
|
# by Mark Biggar
|
|
#
|
|
# Input values to these routines consist of strings of the form
|
|
# m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
|
|
# Examples:
|
|
# "+0/1" canonical zero value
|
|
# "3" canonical value "+3/1"
|
|
# " -123/123 123" canonical value "-1/1001"
|
|
# "123 456/7890" canonical value "+20576/1315"
|
|
# Output values always include a sign and no leading zeros or
|
|
# white space.
|
|
# This package makes use of the bigint package.
|
|
# The string 'NaN' is used to represent the result when input arguments
|
|
# that are not numbers, as well as the result of dividing by zero and
|
|
# the sqrt of a negative number.
|
|
# Extreamly naive algorthims are used.
|
|
#
|
|
# Routines provided are:
|
|
#
|
|
# rneg(RAT) return RAT negation
|
|
# rabs(RAT) return RAT absolute value
|
|
# rcmp(RAT,RAT) return CODE compare numbers (undef,<0,=0,>0)
|
|
# radd(RAT,RAT) return RAT addition
|
|
# rsub(RAT,RAT) return RAT subtraction
|
|
# rmul(RAT,RAT) return RAT multiplication
|
|
# rdiv(RAT,RAT) return RAT division
|
|
# rmod(RAT) return (RAT,RAT) integer and fractional parts
|
|
# rnorm(RAT) return RAT normalization
|
|
# rsqrt(RAT, cycles) return RAT square root
|
|
|
|
# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
|
|
sub main'rnorm { #(string) return rat_num
|
|
local($_) = @_;
|
|
s/\s+//g;
|
|
if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
|
|
&norm($1, $3 ? $3 : '+1');
|
|
} else {
|
|
'NaN';
|
|
}
|
|
}
|
|
|
|
# Normalize by reducing to lowest terms
|
|
sub norm { #(bint, bint) return rat_num
|
|
local($num,$dom) = @_;
|
|
if ($num eq 'NaN') {
|
|
'NaN';
|
|
} elsif ($dom eq 'NaN') {
|
|
'NaN';
|
|
} elsif ($dom =~ /^[+-]?0+$/) {
|
|
'NaN';
|
|
} else {
|
|
local($gcd) = &'bgcd($num,$dom);
|
|
$gcd =~ s/^-/+/;
|
|
if ($gcd ne '+1') {
|
|
$num = &'bdiv($num,$gcd);
|
|
$dom = &'bdiv($dom,$gcd);
|
|
} else {
|
|
$num = &'bnorm($num);
|
|
$dom = &'bnorm($dom);
|
|
}
|
|
substr($dom,$[,1) = '';
|
|
"$num/$dom";
|
|
}
|
|
}
|
|
|
|
# negation
|
|
sub main'rneg { #(rat_num) return rat_num
|
|
local($_) = &'rnorm(@_);
|
|
tr/-+/+-/ if ($_ ne '+0/1');
|
|
$_;
|
|
}
|
|
|
|
# absolute value
|
|
sub main'rabs { #(rat_num) return $rat_num
|
|
local($_) = &'rnorm(@_);
|
|
substr($_,$[,1) = '+' unless $_ eq 'NaN';
|
|
$_;
|
|
}
|
|
|
|
# multipication
|
|
sub main'rmul { #(rat_num, rat_num) return rat_num
|
|
local($xn,$xd) = split('/',&'rnorm($_[$[]));
|
|
local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
|
|
&norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
|
|
}
|
|
|
|
# division
|
|
sub main'rdiv { #(rat_num, rat_num) return rat_num
|
|
local($xn,$xd) = split('/',&'rnorm($_[$[]));
|
|
local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
|
|
&norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
|
|
}
|
|
|
|
# addition
|
|
sub main'radd { #(rat_num, rat_num) return rat_num
|
|
local($xn,$xd) = split('/',&'rnorm($_[$[]));
|
|
local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
|
|
&norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
|
|
}
|
|
|
|
# subtraction
|
|
sub main'rsub { #(rat_num, rat_num) return rat_num
|
|
local($xn,$xd) = split('/',&'rnorm($_[$[]));
|
|
local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
|
|
&norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
|
|
}
|
|
|
|
# comparison
|
|
sub main'rcmp { #(rat_num, rat_num) return cond_code
|
|
local($xn,$xd) = split('/',&'rnorm($_[$[]));
|
|
local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
|
|
&bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
|
|
}
|
|
|
|
# int and frac parts
|
|
sub main'rmod { #(rat_num) return (rat_num,rat_num)
|
|
local($xn,$xd) = split('/',&'rnorm(@_));
|
|
local($i,$f) = &'bdiv($xn,$xd);
|
|
if (wantarray) {
|
|
("$i/1", "$f/$xd");
|
|
} else {
|
|
"$i/1";
|
|
}
|
|
}
|
|
|
|
# square root by Newtons method.
|
|
# cycles specifies the number of iterations default: 5
|
|
sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
|
|
local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
|
|
if ($x eq 'NaN') {
|
|
'NaN';
|
|
} elsif ($x =~ /^-/) {
|
|
'NaN';
|
|
} else {
|
|
local($gscale, $guess) = (0, '+1/1');
|
|
$scale = 5 if (!$scale);
|
|
while ($gscale++ < $scale) {
|
|
$guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
|
|
}
|
|
"$guess"; # quotes necessary due to perl bug
|
|
}
|
|
}
|
|
|
|
1;
|