Rename tied_handle_method() to tied_method(), and make it non-static.
[perl.git] / lib / bigrat.pl
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";
2
3 package bigrat;
4 require "bigint.pl";
5 #
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
9 # release of perl.
10 #
11 # In particular, this should not be used as an example of modern Perl
12 # programming techniques.
13 #
14 # Arbitrary size rational math package
15
16 # by Mark Biggar
17 #
18 # Input values to these routines consist of strings of the form 
19 #   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
20 # Examples:
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
26 #   white space.
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.
32 #
33 # Routines provided are:
34 #
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
45 \f
46 # Convert a number to the canonical string form m|^[+-]\d+/\d+|.
47 sub main'rnorm { #(string) return rat_num
48     local($_) = @_;
49     s/\s+//g;
50     if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
51         &norm($1, $3 ? $3 : '+1');
52     } else {
53         'NaN';
54     }
55 }
56
57 # Normalize by reducing to lowest terms
58 sub norm { #(bint, bint) return rat_num
59     local($num,$dom) = @_;
60     if ($num eq 'NaN') {
61         'NaN';
62     } elsif ($dom eq 'NaN') {
63         'NaN';
64     } elsif ($dom =~ /^[+-]?0+$/) {
65         'NaN';
66     } else {
67         local($gcd) = &'bgcd($num,$dom);
68         $gcd =~ s/^-/+/;
69         if ($gcd ne '+1') { 
70             $num = &'bdiv($num,$gcd);
71             $dom = &'bdiv($dom,$gcd);
72         } else {
73             $num = &'bnorm($num);
74             $dom = &'bnorm($dom);
75         }
76         substr($dom,0,1) = '';
77         "$num/$dom";
78     }
79 }
80
81 # negation
82 sub main'rneg { #(rat_num) return rat_num
83     local($_) = &'rnorm(@_);
84     tr/-+/+-/ if ($_ ne '+0/1');
85     $_;
86 }
87
88 # absolute value
89 sub main'rabs { #(rat_num) return $rat_num
90     local($_) = &'rnorm(@_);
91     substr($_,0,1) = '+' unless $_ eq 'NaN';
92     $_;
93 }
94
95 # multipication
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));
100 }
101
102 # division
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));
107 }
108 \f
109 # addition
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));
114 }
115
116 # subtraction
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));
121 }
122
123 # comparison
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));
128 }
129
130 # int and frac parts
131 sub main'rmod { #(rat_num) return (rat_num,rat_num)
132     local($xn,$xd) = split('/',&'rnorm(@_));
133     local($i,$f) = &'bdiv($xn,$xd);
134     if (wantarray) {
135         ("$i/1", "$f/$xd");
136     } else {
137         "$i/1";
138     }   
139 }
140
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]);
145     if ($x eq 'NaN') {
146         'NaN';
147     } elsif ($x =~ /^-/) {
148         'NaN';
149     } else {
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");
154         }
155         "$guess";          # quotes necessary due to perl bug
156     }
157 }
158
159 1;