1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
6 # This library is no longer being maintained, and is included for backward
7 # compatibility with Perl 4 programs which may require it.
8 # This legacy library is deprecated and will be removed in a future
11 # In particular, this should not be used as an example of modern Perl
12 # programming techniques.
14 # Arbitrary size rational math package
18 # Input values to these routines consist of strings of the form
19 # m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
21 # "+0/1" canonical zero value
22 # "3" canonical value "+3/1"
23 # " -123/123 123" canonical value "-1/1001"
24 # "123 456/7890" canonical value "+20576/1315"
25 # Output values always include a sign and no leading zeros or
27 # This package makes use of the bigint package.
28 # The string 'NaN' is used to represent the result when input arguments
29 # that are not numbers, as well as the result of dividing by zero and
30 # the sqrt of a negative number.
31 # Extreamly naive algorthims are used.
33 # Routines provided are:
35 # rneg(RAT) return RAT negation
36 # rabs(RAT) return RAT absolute value
37 # rcmp(RAT,RAT) return CODE compare numbers (undef,<0,=0,>0)
38 # radd(RAT,RAT) return RAT addition
39 # rsub(RAT,RAT) return RAT subtraction
40 # rmul(RAT,RAT) return RAT multiplication
41 # rdiv(RAT,RAT) return RAT division
42 # rmod(RAT) return (RAT,RAT) integer and fractional parts
43 # rnorm(RAT) return RAT normalization
44 # rsqrt(RAT, cycles) return RAT square root
46 # Convert a number to the canonical string form m|^[+-]\d+/\d+|.
47 sub main'rnorm { #(string) return rat_num
50 if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
51 &norm($1, $3 ? $3 : '+1');
57 # Normalize by reducing to lowest terms
58 sub norm { #(bint, bint) return rat_num
59 local($num,$dom) = @_;
62 } elsif ($dom eq 'NaN') {
64 } elsif ($dom =~ /^[+-]?0+$/) {
67 local($gcd) = &'bgcd($num,$dom);
70 $num = &'bdiv($num,$gcd);
71 $dom = &'bdiv($dom,$gcd);
76 substr($dom,0,1) = '';
82 sub main'rneg { #(rat_num) return rat_num
83 local($_) = &'rnorm(@_);
84 tr/-+/+-/ if ($_ ne '+0/1');
89 sub main'rabs { #(rat_num) return $rat_num
90 local($_) = &'rnorm(@_);
91 substr($_,0,1) = '+' unless $_ eq 'NaN';
96 sub main'rmul { #(rat_num, rat_num) return rat_num
97 local($xn,$xd) = split('/',&'rnorm($_[0]));
98 local($yn,$yd) = split('/',&'rnorm($_[1]));
99 &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
103 sub main'rdiv { #(rat_num, rat_num) return rat_num
104 local($xn,$xd) = split('/',&'rnorm($_[0]));
105 local($yn,$yd) = split('/',&'rnorm($_[1]));
106 &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
110 sub main'radd { #(rat_num, rat_num) return rat_num
111 local($xn,$xd) = split('/',&'rnorm($_[0]));
112 local($yn,$yd) = split('/',&'rnorm($_[1]));
113 &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
117 sub main'rsub { #(rat_num, rat_num) return rat_num
118 local($xn,$xd) = split('/',&'rnorm($_[0]));
119 local($yn,$yd) = split('/',&'rnorm($_[1]));
120 &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
124 sub main'rcmp { #(rat_num, rat_num) return cond_code
125 local($xn,$xd) = split('/',&'rnorm($_[0]));
126 local($yn,$yd) = split('/',&'rnorm($_[1]));
127 &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
131 sub main'rmod { #(rat_num) return (rat_num,rat_num)
132 local($xn,$xd) = split('/',&'rnorm(@_));
133 local($i,$f) = &'bdiv($xn,$xd);
141 # square root by Newtons method.
142 # cycles specifies the number of iterations default: 5
143 sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
144 local($x, $scale) = (&'rnorm($_[0]), $_[1]);
147 } elsif ($x =~ /^-/) {
150 local($gscale, $guess) = (0, '+1/1');
151 $scale = 5 if (!$scale);
152 while ($gscale++ < $scale) {
153 $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
155 "$guess"; # quotes necessary due to perl bug