| 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; |