[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 1303 - (download) (as text) (annotate)
Mon Jun 30 20:36:57 2003 UTC (16 years, 7 months ago) by apizer
File size: 5914 byte(s)
added missing hyperbolic, inverse trig, and inverse hyperbolic functions
cintributed by Davide Cervone

Arnie

    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 #
   61 #  DPVC  -- 2002/03/31
   62 #        added missing trig, inverse and hyperbolic functions
   63 #
   64 sub csch {2.0/(exp($_[0]) - exp(-$_[0]))}
   65 sub coth {(exp($_[0]) + exp(-$_[0]))/(exp($_[0]) - exp(-$_[0]))}
   66 
   67 sub arcsec {acos(1.0/$_[0])}; sub asec {acos(1.0/$_[0])}
   68 sub arccsc {asin(1.0/$_[0])}; sub acsc {asin(1.0/$_[0])}
   69 
   70 sub arcsinh {log($_[0]+sqrt($_[0]*$_[0]+1.0))}
   71 sub arccosh {log($_[0]+sqrt($_[0]*$_[0]-1.0))}
   72 sub arctanh {log((1.0+$_[0])/(1.0-$_[0]))/2.0}
   73 sub arcsech {log((1.0+sqrt(1-$_[0]*$_[0]))/$_[0])}
   74 sub arccsch {log((1.0+sqrt(1+$_[0]*$_[0]))/$_[0])}
   75 sub arccoth {log(($_[0]+1.0)/($_[0]-1.0))/2.0}
   76 
   77 sub asinh {log($_[0]+sqrt($_[0]*$_[0]+1.0))}
   78 sub acosh {log($_[0]+sqrt($_[0]*$_[0]-1.0))}
   79 sub atanh {log((1.0+$_[0])/(1.0-$_[0]))/2.0}
   80 sub asech {log((1.0+sqrt(1-$_[0]*$_[0]))/$_[0])}
   81 sub acsch {log((1.0+sqrt(1+$_[0]*$_[0]))/$_[0])}
   82 sub acoth {log(($_[0]+1.0)/($_[0]-1.0))/2.0}
   83 #
   84 #  End DPVC
   85 #
   86 sub sgn {
   87   my $x = shift;
   88   my $out;
   89   $out = 1 if $x > 0;
   90   $out = 0 if $x == 0;
   91   $out = -1 if $x<0;
   92   $out;
   93 }
   94 sub step {     # heavyside function (1 or x>0)
   95   my $x = shift;
   96   ($x > 0 ) ? 1 : 0;
   97 }
   98 sub ceil {
   99   my $x = shift;
  100   - floor(-$x);
  101 }
  102 sub floor {
  103   my $input = shift;
  104   my $out = int $input;
  105   $out -- if ( $out <= 0 and ($out-$input) > 0 );  # does the right thing for negative numbers
  106   $out;
  107 }
  108 
  109 sub max {
  110 
  111         my $maxVal = shift;
  112         my @input = @_;
  113 
  114         foreach my $num (@input) {
  115                 $maxVal = $num if ($maxVal < $num);
  116         }
  117 
  118         $maxVal;
  119 
  120 }
  121 
  122 sub min {
  123 
  124         my $minVal = shift;
  125         my @input = @_;
  126 
  127         foreach my $num (@input) {
  128                 $minVal = $num if ($minVal > $num);
  129         }
  130 
  131         $minVal;
  132 
  133 }
  134 
  135 #round added 6/12/2000 by David Etlinger. Edited by AKP 3-6-03
  136 
  137 sub round {
  138   my $input = shift;
  139   my $out = Round($input);
  140 # if( $input >= 0 ) {
  141 #   $out = int ($input + .5);
  142 # }
  143 # else {
  144 #   $out = ceil($input - .5);
  145 # }
  146   $out;
  147 }
  148 
  149 # Round contributed bt Mark Schmitt 3-6-03
  150 sub Round {
  151   if (@_ == 1) { $_[0] > 0 ? int $_[0] + 0.5 : int $_[0] - 0.5}
  152   elsif (@_ == 2) { $_[0] > 0 ? Round($_[0]*10**$_[1])/10**$_[1] :Round($_[0]*10**$_[1])/10**$_[1]}
  153 }
  154 
  155 #least common multiple
  156 #VS 6/29/2000
  157 sub lcm {
  158   my $a = shift;
  159   my $b = shift;
  160 
  161   #reorder such that $a is the smaller number
  162   if ($a > $b) {
  163     my $temp = $a;
  164     $a = $b;
  165     $b = $temp;
  166   }
  167 
  168   my $lcm = 0;
  169   my $curr = $b;;
  170 
  171   while($lcm == 0) {
  172     $lcm = $curr if ($curr % $a == 0);
  173     $curr += $b;
  174   }
  175 
  176   $lcm;
  177 
  178 }
  179 
  180 
  181 # greatest common factor
  182 # takes in two scalar values and uses the Euclidean Algorithm to return the gcf
  183 #VS 6/29/2000
  184 
  185 sub gcf {
  186         my $a = abs(shift); # absolute values because this will yield the same gcd,
  187         my $b = abs(shift); # but allows use of the mod operation
  188 
  189   # reorder such that b is the smaller number
  190   if ($a < $b) {
  191     my $temp = $a;
  192     $a = $b;
  193     $b = $temp;
  194   }
  195 
  196   return $a if $b == 0;
  197 
  198   my $q = int($a/$b); # quotient
  199   my $r = $a % $b;  # remainder
  200 
  201   return $b if $r == 0;
  202 
  203   my $tempR = $r;
  204 
  205   while ($r != 0) {
  206 
  207     #keep track of what $r was in the last loop, as this is the value
  208     #we will want when $r is set to 0
  209     $tempR = $r;
  210 
  211     $a = $b;
  212     $b = $r;
  213     $q = $a/$b;
  214     $r = $a % $b;
  215 
  216   }
  217 
  218   $tempR;
  219 }
  220 
  221 
  222 #greatest common factor.
  223 #same as gcf, but both names are sufficiently common names
  224 sub gcd {
  225         return gcf($_[0], $_[1]);
  226 }
  227 
  228 #returns 1 for a prime number, else 0
  229 #VS 6/30/2000
  230 sub isPrime {
  231         my $num = shift;
  232         return 1 if ($num == 2 or $num == 3);
  233         return 0 if ($num == 1 or $num == 0);
  234         for (my $i = 2; $i <= sqrt($num); $i++) { return 0 if ($num % $i == 0); }
  235         return 1;
  236 }
  237 
  238 #reduces a fraction, returning an array containing ($numerator, $denominator)
  239 #VS 7/10/2000
  240 sub reduce {
  241 
  242   my $num = shift;
  243   my $denom = shift;
  244   my $gcd = gcd($num, $denom);
  245 
  246   $num = $num/$gcd;
  247   $denom = $denom/$gcd;
  248 
  249   # formats such that only the numerator will be negative
  250   if ($num/$denom < 0) {$num = -abs($num); $denom = abs($denom);}
  251   else {$num = abs($num); $denom = abs($denom);}
  252 
  253   my @frac = ($num, $denom);
  254   @frac;
  255 }
  256 
  257 
  258 # takes a number and fixed object, as in "$a x" and formats
  259 # to account for when $a = 0, 1, -1
  260 # Usage: format($scalar, "quoted string");
  261 # Example: format(-1, "\pi") returns "-\pi"
  262 # VS 8/1/2000  -  slight adaption of code from T. Shemanske of Dartmouth College
  263 sub preformat {
  264   my $num = shift;
  265   my $obj = shift;
  266   my $out;
  267 
  268 
  269   if ($num == 0) { return 0; }
  270   elsif ($num == 1) { return $obj; }
  271   elsif ($num == -1) { return "-".$obj; }
  272 
  273   return $num.$obj;
  274 }
  275 
  276 # Combinations and permutations
  277 
  278 sub C {
  279   my $n = shift;
  280   my $k = shift;
  281   my $ans = 1;
  282 
  283   if($k>($n-$k)) { $k = $n-$k; }
  284   for (1..$k) { $ans = ($ans*($n-$_+1))/$_; }
  285   return $ans;
  286 }
  287 
  288 sub Comb {
  289   C(@_);
  290 }
  291 
  292 sub P {
  293   my $n = shift;
  294   my $k = shift;
  295   my $perm = 1;
  296 
  297   if($n != int($n) or $n < 0) {
  298                 warn 'Non-negative integer required.';
  299                 return;
  300         }
  301   if($k>$n) {
  302     warn 'Second argument of Permutation bigger than first.';
  303                 return;
  304         }
  305   for (($n-$k+1)..$n) { $perm *= $_;}
  306   return $perm;
  307 }
  308 
  309 sub Perm {
  310   P(@_);
  311 }
  312 
  313 #factorial
  314 
  315 sub fact {
  316   P($_[0], $_[0]);
  317 }
  318 
  319 # return 1 so that this file can be included with require
  320 1

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9