[system] / trunk / pg / macros / PGauxiliaryFunctions.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGauxiliaryFunctions.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4997 - (download) (as text) (annotate)
Mon Jun 11 18:16:40 2007 UTC (12 years, 8 months ago) by gage
File size: 4058 byte(s)
Fixing docementation so that it can be read from the web.

    1 
    2 sub _PGauxiliaryFunctions_init {
    3 
    4 }
    5 
    6 =head1 DESCRIPTION
    7 
    8 #
    9 #  Get the functions that are in common with Parser.pm
   10 #
   11 
   12 =cut
   13 
   14 loadMacros("PGcommonFunctions.pl");
   15 
   16 =head3
   17 
   18 #
   19 #  Do the additional functions such as:
   20 #
   21 #  step($number)
   22 #  ceil($number)
   23 #  floor($number)
   24 #  max(@listNumbers)
   25 #  min(@listNumbers)
   26 #  round($number)
   27 #  lcm($number1,$number2)
   28 #  gfc($number1,$number2)
   29 #  gcd($number1,$number2)
   30 #  isPrime($number)
   31 #  reduce($numerator,$denominator)
   32 #  preformat($scalar, "QuotedString")
   33 #
   34 
   35 =cut
   36 
   37 sub step {     # heavyside function (1 or x>0)
   38   my $x = shift;
   39   ($x > 0 ) ? 1 : 0;
   40 }
   41 sub ceil {
   42   my $x = shift;
   43   - floor(-$x);
   44 }
   45 sub floor {
   46   my $input = shift;
   47   my $out = int $input;
   48   $out -- if ( $out <= 0 and ($out-$input) > 0 );  # does the right thing for negative numbers
   49   $out;
   50 }
   51 
   52 sub max {
   53 
   54         my $maxVal = shift;
   55         my @input = @_;
   56 
   57         foreach my $num (@input) {
   58                 $maxVal = $num if ($maxVal < $num);
   59         }
   60 
   61         $maxVal;
   62 
   63 }
   64 
   65 sub min {
   66 
   67         my $minVal = shift;
   68         my @input = @_;
   69 
   70         foreach my $num (@input) {
   71                 $minVal = $num if ($minVal > $num);
   72         }
   73 
   74         $minVal;
   75 
   76 }
   77 
   78 #round added 6/12/2000 by David Etlinger. Edited by AKP 3-6-03
   79 
   80 sub round {
   81   my $input = shift;
   82   my $out = Round($input);
   83 # if( $input >= 0 ) {
   84 #   $out = int ($input + .5);
   85 # }
   86 # else {
   87 #   $out = ceil($input - .5);
   88 # }
   89   $out;
   90 }
   91 
   92 # Round contributed bt Mark Schmitt 3-6-03
   93 sub Round {
   94   if (@_ == 1) { $_[0] > 0 ? int $_[0] + 0.5 : int $_[0] - 0.5}
   95   elsif (@_ == 2) { $_[0] > 0 ? Round($_[0]*10**$_[1])/10**$_[1] :Round($_[0]*10**$_[1])/10**$_[1]}
   96 }
   97 
   98 #least common multiple
   99 #VS 6/29/2000
  100 sub lcm {
  101   my $a = shift;
  102   my $b = shift;
  103 
  104   #reorder such that $a is the smaller number
  105   if ($a > $b) {
  106     my $temp = $a;
  107     $a = $b;
  108     $b = $temp;
  109   }
  110 
  111   my $lcm = 0;
  112   my $curr = $b;;
  113 
  114   while($lcm == 0) {
  115     $lcm = $curr if ($curr % $a == 0);
  116     $curr += $b;
  117   }
  118 
  119   $lcm;
  120 
  121 }
  122 
  123 
  124 # greatest common factor
  125 # takes in two scalar values and uses the Euclidean Algorithm to return the gcf
  126 #VS 6/29/2000
  127 
  128 sub gcf {
  129         my $a = abs(shift); # absolute values because this will yield the same gcd,
  130         my $b = abs(shift); # but allows use of the mod operation
  131 
  132   # reorder such that b is the smaller number
  133   if ($a < $b) {
  134     my $temp = $a;
  135     $a = $b;
  136     $b = $temp;
  137   }
  138 
  139   return $a if $b == 0;
  140 
  141   my $q = int($a/$b); # quotient
  142   my $r = $a % $b;  # remainder
  143 
  144   return $b if $r == 0;
  145 
  146   my $tempR = $r;
  147 
  148   while ($r != 0) {
  149 
  150     #keep track of what $r was in the last loop, as this is the value
  151     #we will want when $r is set to 0
  152     $tempR = $r;
  153 
  154     $a = $b;
  155     $b = $r;
  156     $q = $a/$b;
  157     $r = $a % $b;
  158 
  159   }
  160 
  161   $tempR;
  162 }
  163 
  164 
  165 #greatest common factor.
  166 #same as gcf, but both names are sufficiently common names
  167 sub gcd {
  168         return gcf($_[0], $_[1]);
  169 }
  170 
  171 #returns 1 for a prime number, else 0
  172 #VS 6/30/2000
  173 sub isPrime {
  174         my $num = shift;
  175         return 1 if ($num == 2 or $num == 3);
  176         return 0 if ($num == 1 or $num == 0);
  177         for (my $i = 2; $i <= sqrt($num); $i++) { return 0 if ($num % $i == 0); }
  178         return 1;
  179 }
  180 
  181 #reduces a fraction, returning an array containing ($numerator, $denominator)
  182 #VS 7/10/2000
  183 sub reduce {
  184 
  185   my $num = shift;
  186   my $denom = shift;
  187   my $gcd = gcd($num, $denom);
  188 
  189   $num = $num/$gcd;
  190   $denom = $denom/$gcd;
  191 
  192   # formats such that only the numerator will be negative
  193   if ($num/$denom < 0) {$num = -abs($num); $denom = abs($denom);}
  194   else {$num = abs($num); $denom = abs($denom);}
  195 
  196   my @frac = ($num, $denom);
  197   @frac;
  198 }
  199 
  200 
  201 # takes a number and fixed object, as in "$a x" and formats
  202 # to account for when $a = 0, 1, -1
  203 # Usage: preformat($scalar, "quoted string");
  204 # Example: preformat(-1, "\pi") returns "-\pi"
  205 # VS 8/1/2000  -  slight adaption of code from T. Shemanske of Dartmouth College
  206 sub preformat {
  207   my $num = shift;
  208   my $obj = shift;
  209   my $out;
  210 
  211 
  212   if ($num == 0) { return 0; }
  213   elsif ($num == 1) { return $obj; }
  214   elsif ($num == -1) { return "-".$obj; }
  215 
  216   return $num.$obj;
  217 }
  218 
  219 #factorial
  220 
  221 sub fact {
  222   P($_[0], $_[0]);
  223 }
  224 
  225 # return 1 so that this file can be included with require
  226 1

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9