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