Edit File: bigrat.pl
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;
Back to File Manager