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