1package bigrat;
2require "bigint.pl";
3#
4# This library is no longer being maintained, and is included for backward
5# compatibility with Perl 4 programs which may require it.
6#
7# In particular, this should not be used as an example of modern Perl
8# programming techniques.
9#
10# Arbitrary size rational math package
11#
12# by Mark Biggar
13#
14# Input values to these routines consist of strings of the form
15#   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
16# Examples:
17#   "+0/1"                          canonical zero value
18#   "3"                             canonical value "+3/1"
19#   "   -123/123 123"               canonical value "-1/1001"
20#   "123 456/7890"                  canonical value "+20576/1315"
21# Output values always include a sign and no leading zeros or
22#   white space.
23# This package makes use of the bigint package.
24# The string 'NaN' is used to represent the result when input arguments
25#   that are not numbers, as well as the result of dividing by zero and
26#       the sqrt of a negative number.
27# Extreamly naive algorthims are used.
28#
29# Routines provided are:
30#
31#   rneg(RAT) return RAT                negation
32#   rabs(RAT) return RAT                absolute value
33#   rcmp(RAT,RAT) return CODE           compare numbers (undef,<0,=0,>0)
34#   radd(RAT,RAT) return RAT            addition
35#   rsub(RAT,RAT) return RAT            subtraction
36#   rmul(RAT,RAT) return RAT            multiplication
37#   rdiv(RAT,RAT) return RAT            division
38#   rmod(RAT) return (RAT,RAT)          integer and fractional parts
39#   rnorm(RAT) return RAT               normalization
40#   rsqrt(RAT, cycles) return RAT       square root
41
42# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
43sub main'rnorm { #(string) return rat_num
44    local($_) = @_;
45    s/\s+//g;
46    if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
47	&norm($1, $3 ? $3 : '+1');
48    } else {
49	'NaN';
50    }
51}
52
53# Normalize by reducing to lowest terms
54sub norm { #(bint, bint) return rat_num
55    local($num,$dom) = @_;
56    if ($num eq 'NaN') {
57	'NaN';
58    } elsif ($dom eq 'NaN') {
59	'NaN';
60    } elsif ($dom =~ /^[+-]?0+$/) {
61	'NaN';
62    } else {
63	local($gcd) = &'bgcd($num,$dom);
64	$gcd =~ s/^-/+/;
65	if ($gcd ne '+1') {
66	    $num = &'bdiv($num,$gcd);
67	    $dom = &'bdiv($dom,$gcd);
68	} else {
69	    $num = &'bnorm($num);
70	    $dom = &'bnorm($dom);
71	}
72	substr($dom,0,1) = '';
73	"$num/$dom";
74    }
75}
76
77# negation
78sub main'rneg { #(rat_num) return rat_num
79    local($_) = &'rnorm(@_);
80    tr/-+/+-/ if ($_ ne '+0/1');
81    $_;
82}
83
84# absolute value
85sub main'rabs { #(rat_num) return $rat_num
86    local($_) = &'rnorm(@_);
87    substr($_,0,1) = '+' unless $_ eq 'NaN';
88    $_;
89}
90
91# multipication
92sub main'rmul { #(rat_num, rat_num) return rat_num
93    local($xn,$xd) = split('/',&'rnorm($_[0]));
94    local($yn,$yd) = split('/',&'rnorm($_[1]));
95    &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
96}
97
98# division
99sub main'rdiv { #(rat_num, rat_num) return rat_num
100    local($xn,$xd) = split('/',&'rnorm($_[0]));
101    local($yn,$yd) = split('/',&'rnorm($_[1]));
102    &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
103}
104
105# addition
106sub main'radd { #(rat_num, rat_num) return rat_num
107    local($xn,$xd) = split('/',&'rnorm($_[0]));
108    local($yn,$yd) = split('/',&'rnorm($_[1]));
109    &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
110}
111
112# subtraction
113sub main'rsub { #(rat_num, rat_num) return rat_num
114    local($xn,$xd) = split('/',&'rnorm($_[0]));
115    local($yn,$yd) = split('/',&'rnorm($_[1]));
116    &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
117}
118
119# comparison
120sub main'rcmp { #(rat_num, rat_num) return cond_code
121    local($xn,$xd) = split('/',&'rnorm($_[0]));
122    local($yn,$yd) = split('/',&'rnorm($_[1]));
123    &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
124}
125
126# int and frac parts
127sub main'rmod { #(rat_num) return (rat_num,rat_num)
128    local($xn,$xd) = split('/',&'rnorm(@_));
129    local($i,$f) = &'bdiv($xn,$xd);
130    if (wantarray) {
131	("$i/1", "$f/$xd");
132    } else {
133	"$i/1";
134    }
135}
136
137# square root by Newtons method.
138#   cycles specifies the number of iterations default: 5
139sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
140    local($x, $scale) = (&'rnorm($_[0]), $_[1]);
141    if ($x eq 'NaN') {
142	'NaN';
143    } elsif ($x =~ /^-/) {
144	'NaN';
145    } else {
146	local($gscale, $guess) = (0, '+1/1');
147	$scale = 5 if (!$scale);
148	while ($gscale++ < $scale) {
149	    $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
150	}
151	"$guess";          # quotes necessary due to perl bug
152    }
153}
154
1551;
156