diff options
Diffstat (limited to 'contrib/perl5/lib/bigrat.pl')
| -rw-r--r-- | contrib/perl5/lib/bigrat.pl | 155 |
1 files changed, 0 insertions, 155 deletions
diff --git a/contrib/perl5/lib/bigrat.pl b/contrib/perl5/lib/bigrat.pl deleted file mode 100644 index 2d3738f..0000000 --- a/contrib/perl5/lib/bigrat.pl +++ /dev/null @@ -1,155 +0,0 @@ -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; |
