Commit | Line | Data |
---|---|---|
0111154e Z |
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 | ||
5303340c LW |
3 | package bigrat; |
4 | require "bigint.pl"; | |
a6d71656 GS |
5 | # |
6 | # This library is no longer being maintained, and is included for backward | |
7 | # compatibility with Perl 4 programs which may require it. | |
5170d013 S |
8 | # This legacy library is deprecated and will be removed in a future |
9 | # release of perl. | |
a6d71656 GS |
10 | # |
11 | # In particular, this should not be used as an example of modern Perl | |
12 | # programming techniques. | |
13 | # | |
5303340c | 14 | # Arbitrary size rational math package |
5170d013 | 15 | |
bf10efe7 LW |
16 | # by Mark Biggar |
17 | # | |
5303340c LW |
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. | |
98dc9551 | 31 | # Extremely naive algorithms are used. |
5303340c LW |
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); | |
748a9306 | 68 | $gcd =~ s/^-/+/; |
5303340c LW |
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 | } | |
859172fe | 76 | substr($dom,0,1) = ''; |
5303340c LW |
77 | "$num/$dom"; |
78 | } | |
79 | } | |
80 | ||
81 | # negation | |
82 | sub main'rneg { #(rat_num) return rat_num | |
79072805 | 83 | local($_) = &'rnorm(@_); |
5303340c LW |
84 | tr/-+/+-/ if ($_ ne '+0/1'); |
85 | $_; | |
86 | } | |
87 | ||
88 | # absolute value | |
89 | sub main'rabs { #(rat_num) return $rat_num | |
79072805 | 90 | local($_) = &'rnorm(@_); |
859172fe | 91 | substr($_,0,1) = '+' unless $_ eq 'NaN'; |
5303340c LW |
92 | $_; |
93 | } | |
94 | ||
95 | # multipication | |
96 | sub main'rmul { #(rat_num, rat_num) return rat_num | |
859172fe Z |
97 | local($xn,$xd) = split('/',&'rnorm($_[0])); |
98 | local($yn,$yd) = split('/',&'rnorm($_[1])); | |
5303340c LW |
99 | &norm(&'bmul($xn,$yn),&'bmul($xd,$yd)); |
100 | } | |
101 | ||
102 | # division | |
103 | sub main'rdiv { #(rat_num, rat_num) return rat_num | |
859172fe Z |
104 | local($xn,$xd) = split('/',&'rnorm($_[0])); |
105 | local($yn,$yd) = split('/',&'rnorm($_[1])); | |
5303340c LW |
106 | &norm(&'bmul($xn,$yd),&'bmul($xd,$yn)); |
107 | } | |
108 | \f | |
109 | # addition | |
110 | sub main'radd { #(rat_num, rat_num) return rat_num | |
859172fe Z |
111 | local($xn,$xd) = split('/',&'rnorm($_[0])); |
112 | local($yn,$yd) = split('/',&'rnorm($_[1])); | |
5303340c LW |
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 | |
859172fe Z |
118 | local($xn,$xd) = split('/',&'rnorm($_[0])); |
119 | local($yn,$yd) = split('/',&'rnorm($_[1])); | |
5303340c LW |
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 | |
859172fe Z |
125 | local($xn,$xd) = split('/',&'rnorm($_[0])); |
126 | local($yn,$yd) = split('/',&'rnorm($_[1])); | |
5303340c LW |
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) | |
79072805 | 132 | local($xn,$xd) = split('/',&'rnorm(@_)); |
5303340c LW |
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 | |
859172fe | 144 | local($x, $scale) = (&'rnorm($_[0]), $_[1]); |
5303340c LW |
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; |