[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 1090 - (download) (as text) (annotate)
Mon Jun 9 21:24:08 2003 UTC (16 years, 8 months ago) by gage
File size: 5013 byte(s)
Fixed a patch to round (and Round) originally due to Mark Schmitt
which didn't get included in the latest updates and transfer to pg
--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9