Parent Directory
| 
Revision Log
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 |