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

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