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