[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 5658 - (download) (as text) (annotate)
Sat May 3 17:43:29 2008 UTC (11 years, 9 months ago) by sh002i
File size: 4383 byte(s)
markup for ww-symbol-map

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9