Parent Directory
| 
Revision Log
Revision 2584 - (view) (download) (as text)
| 1 : | aubreyja | 2584 | sub textbook_ref { |
| 2 : | my ($text, $sec, $ex) = @_; | ||
| 3 : | return "$text section $sec, exercise $ex"; | ||
| 4 : | } | ||
| 5 : | |||
| 6 : | sub textbook_ref_corr { | ||
| 7 : | return "Similar to " . textbook_ref(@_) . "."; | ||
| 8 : | } | ||
| 9 : | |||
| 10 : | sub textbook_ref_exact { | ||
| 11 : | return "From " . textbook_ref(@_) . "."; | ||
| 12 : | } | ||
| 13 : | |||
| 14 : | sub list_random_multi_uniq($@) { | ||
| 15 : | my ($n, @list) = @_; | ||
| 16 : | my @result; | ||
| 17 : | while (@result < $n) { | ||
| 18 : | my $i = random(0,$#list,1); | ||
| 19 : | if ($i==0) { | ||
| 20 : | push @result, shift @list; | ||
| 21 : | } elsif ($i==$#list) { | ||
| 22 : | push @result, pop @list; | ||
| 23 : | } else { | ||
| 24 : | push @result, $list[$i]; | ||
| 25 : | $list[$i] = pop @list; | ||
| 26 : | } | ||
| 27 : | } | ||
| 28 : | return @result; | ||
| 29 : | } | ||
| 30 : | |||
| 31 : | sub IINT { | ||
| 32 : | return '\int\!\!\int'; | ||
| 33 : | } | ||
| 34 : | |||
| 35 : | sub IIINT { | ||
| 36 : | return '\int\!\!\int\!\!\int'; | ||
| 37 : | } | ||
| 38 : | |||
| 39 : | $IINT = IINT(); | ||
| 40 : | $IIINT = IIINT(); | ||
| 41 : | |||
| 42 : | sub VUSAGE { | ||
| 43 : | return $BBOLD . ' Usage: ' . $EBOLD . 'To enter a vector, for example \(\langle x,y,z\rangle\), type "' . $LTS . ' x, y, z ' . $GTS . '".'; | ||
| 44 : | } | ||
| 45 : | |||
| 46 : | $VUSAGE = VUSAGE(); | ||
| 47 : | |||
| 48 : | sub PUSAGE { | ||
| 49 : | return $BBOLD . ' Usage: ' . $EBOLD . 'To enter a point, for example \( (x,y,z) \), type "(x, y, z)".'; | ||
| 50 : | } | ||
| 51 : | |||
| 52 : | $PUSAGE = PUSAGE(); | ||
| 53 : | |||
| 54 : | #sam# copied from bkellMacros.pl -- no reason to maintain two macro files. | ||
| 55 : | #sam# FIXME -- these should probably lose their "bkell_" prefixes. | ||
| 56 : | |||
| 57 : | # bkellMacros.pl | ||
| 58 : | # Brian Kell <bkell@cse.unl.edu> | ||
| 59 : | # Last updated 3:24 CDT, 24 Jun 2007 | ||
| 60 : | |||
| 61 : | ############################################################################### | ||
| 62 : | # bkell_linear_simplify($a, $b) | ||
| 63 : | # | ||
| 64 : | # Returns a string representing $a*x+$b in simplified form, where "simplified" | ||
| 65 : | # means something along the lines of the following: | ||
| 66 : | # | ||
| 67 : | # a b output | ||
| 68 : | # --- --- ------ | ||
| 69 : | # 0 0 0 | ||
| 70 : | # 1 1 x+1 | ||
| 71 : | # -1 -1 -x-1 | ||
| 72 : | # -1 5 5-x | ||
| 73 : | # 2 0 2x | ||
| 74 : | # -4 3 3-4x | ||
| 75 : | # -4 -3 -4x-3 | ||
| 76 : | # | ||
| 77 : | sub bkell_linear_simplify | ||
| 78 : | { | ||
| 79 : | my ($a, $b) = @_; | ||
| 80 : | |||
| 81 : | if ($a == 0) { | ||
| 82 : | return "$b"; | ||
| 83 : | } elsif ($b == 0) { | ||
| 84 : | if ($a == -1) { | ||
| 85 : | return "-x"; | ||
| 86 : | } elsif ($a == 1) { | ||
| 87 : | return "x"; | ||
| 88 : | } else { | ||
| 89 : | return "${a}x"; | ||
| 90 : | } | ||
| 91 : | } elsif ($a < 0 && $b > 0) { | ||
| 92 : | if ($a == -1) { | ||
| 93 : | return "$b-x"; | ||
| 94 : | } else { | ||
| 95 : | return "$b-".(abs $a)."x"; | ||
| 96 : | } | ||
| 97 : | } elsif ($a == 1) { | ||
| 98 : | return "x".sprintf("%+d", $b); | ||
| 99 : | } elsif ($a == -1) { | ||
| 100 : | return "-x".sprintf("%+d", $b); | ||
| 101 : | } else { | ||
| 102 : | return "${a}x".sprintf("%+d", $b); | ||
| 103 : | } | ||
| 104 : | } | ||
| 105 : | |||
| 106 : | ############################################################################### | ||
| 107 : | # bkell_simplify_fraction($num, $denom) | ||
| 108 : | # | ||
| 109 : | # Simplifies the fraction $num/$denom; returns the list ($num, $denom). | ||
| 110 : | # | ||
| 111 : | sub bkell_simplify_fraction | ||
| 112 : | { | ||
| 113 : | my ($num, $denom) = @_; | ||
| 114 : | |||
| 115 : | if ($num == 0) { return (0, 1); } | ||
| 116 : | |||
| 117 : | my $sign = +1; | ||
| 118 : | if ($num < 0) { $sign *= -1; $num *= -1; } | ||
| 119 : | if ($denom < 0) { $sign *= -1; $denom *= -1; } | ||
| 120 : | |||
| 121 : | for ($i = 2; $i <= $num && $i <= $denom; ++$i) { | ||
| 122 : | while ($num % $i == 0 && $denom % $i == 0) { | ||
| 123 : | $num /= $i; | ||
| 124 : | $denom /= $i; | ||
| 125 : | } | ||
| 126 : | } | ||
| 127 : | |||
| 128 : | return ($sign*$num, $denom); | ||
| 129 : | } | ||
| 130 : | |||
| 131 : | ############################################################################### | ||
| 132 : | # bkell_simplify_fraction_string($num, $denom [, $flags]) | ||
| 133 : | # | ||
| 134 : | # Returns a string like "$num/$denom" in simplified form. If the string $flags | ||
| 135 : | # contains "+", then a leading "+" is included if the fraction is non-negative. | ||
| 136 : | # If $flags contains "0", then a fraction with a value of 0 will cause the | ||
| 137 : | # empty string to be returned. If $flags contains "1", then a fraction with a | ||
| 138 : | # value of 1 or -1 will cause only the sign to be returned (or the empty | ||
| 139 : | # string, if the fraction is non-negative and $flags does not contain "+"). If | ||
| 140 : | # $flags contains "(", then parentheses will be placed around "$num/$denom" | ||
| 141 : | # (the sign, if it exists, will be outside the parentheses); if $flags contains | ||
| 142 : | # "[", then parentheses will be used only if a sign is used and the denominator | ||
| 143 : | # is other than 1. A flag of "(" overrides "]". If $flags contains "f", then | ||
| 144 : | # the string returned will be in the form "{$num \over $denom}" instead of the | ||
| 145 : | # normal slashed version. | ||
| 146 : | # | ||
| 147 : | sub bkell_simplify_fraction_string | ||
| 148 : | { | ||
| 149 : | my ($num, $denom, $flags) = @_; | ||
| 150 : | if (!defined $flags) { $flags = ""; } | ||
| 151 : | |||
| 152 : | ($num, $denom) = bkell_simplify_fraction($num, $denom); | ||
| 153 : | |||
| 154 : | my $sign = ($num >= 0 ? ($flags =~ /\+/ ? "+" : "") : "-"); | ||
| 155 : | $num = abs $num; | ||
| 156 : | |||
| 157 : | my ($pre, $post); | ||
| 158 : | if ($flags =~ /\(/ || ($flags =~ /\[/ && $sign ne "" && $denom != 1)) { | ||
| 159 : | ($pre, $post) = ("(", ")"); | ||
| 160 : | } else { | ||
| 161 : | ($pre, $post) = ("", ""); | ||
| 162 : | } | ||
| 163 : | |||
| 164 : | if ($num == 0 && $flags =~ /0/) { return ""; } | ||
| 165 : | if ($denom == 1) { | ||
| 166 : | if ($num == 1 && $flags =~ /1/) { return "$sign"; } | ||
| 167 : | return "$sign$pre$num$post"; | ||
| 168 : | } | ||
| 169 : | if ($flags =~ /f/) { return "$sign$pre {$num \\over $denom}$post"; } | ||
| 170 : | return "$sign$pre$num/$denom$post"; | ||
| 171 : | } | ||
| 172 : | |||
| 173 : | ############################################################################### | ||
| 174 : | # bkell_poly_term($coeff_num, $coeff_denom, $var [, "+"]) | ||
| 175 : | # | ||
| 176 : | # Produces and simplifies a term of a polynomial of the general form | ||
| 177 : | # "($coeff_num/$coeff_denom)$var". Handles special cases (such as $num==0, | ||
| 178 : | # $denom==1, etc.). If the fourth argument is "+", then a leading "+" is | ||
| 179 : | # included if the term is positive. | ||
| 180 : | # | ||
| 181 : | sub bkell_poly_term | ||
| 182 : | { | ||
| 183 : | my ($coeff_num, $coeff_denom, $var, $plus) = @_; | ||
| 184 : | if (!defined $plus) { $plus = ""; } | ||
| 185 : | |||
| 186 : | if ($coeff_num == 0) { return ""; } | ||
| 187 : | |||
| 188 : | my $sign = +1; | ||
| 189 : | if ($coeff_num < 0) { $sign *= -1; $coeff_num *= -1; } | ||
| 190 : | if ($coeff_denom < 0) { $sign *= -1; $coeff_denom *= -1; } | ||
| 191 : | $sign = ($sign > 0 ? ($plus eq "+" ? "+" : "") : "-"); | ||
| 192 : | |||
| 193 : | my ($num, $denom) = bkell_simplify_fraction($coeff_num, $coeff_denom); | ||
| 194 : | |||
| 195 : | if ($denom == 1) { | ||
| 196 : | if ($num == 1) { | ||
| 197 : | return "$sign$var"; | ||
| 198 : | } else { | ||
| 199 : | return "$sign$num$var"; | ||
| 200 : | } | ||
| 201 : | } | ||
| 202 : | |||
| 203 : | return "$sign($num/$denom)$var"; | ||
| 204 : | } | ||
| 205 : | |||
| 206 : | ############################################################################### | ||
| 207 : | # bkell_gcd($x, $y) | ||
| 208 : | # | ||
| 209 : | # Returns the greatest common divisor of $x and $y. | ||
| 210 : | # | ||
| 211 : | sub bkell_gcd { | ||
| 212 : | my ($x, $y) = @_; | ||
| 213 : | $x = abs $x; | ||
| 214 : | $y = abs $y; | ||
| 215 : | if ($x > $y) { ($x, $y) = ($y, $x); } | ||
| 216 : | if ($x == 0) { return $y; } | ||
| 217 : | my $r = $y % $x; | ||
| 218 : | if ($r == 0) { return $x; } | ||
| 219 : | return bkell_gcd($x, $r); | ||
| 220 : | } | ||
| 221 : | |||
| 222 : | ############################################################################### | ||
| 223 : | # bkell_poly_eval($x, $a_n, ..., $a_0) | ||
| 224 : | # | ||
| 225 : | # Evaluates the polynomial a_n*x^n + ... + a_1*x + a_0 at the given value of x. | ||
| 226 : | # | ||
| 227 : | sub bkell_poly_eval | ||
| 228 : | { | ||
| 229 : | my $x = shift; | ||
| 230 : | my $value = shift; | ||
| 231 : | while (@_) { $value *= $x; $value += shift; } | ||
| 232 : | return $value; | ||
| 233 : | } | ||
| 234 : | |||
| 235 : | ############################################################################### | ||
| 236 : | # bkell_real_zeros_finder($a_n, ..., $a_0) | ||
| 237 : | # | ||
| 238 : | # Returns a list of numerical approximations of the zeros of the polynomial | ||
| 239 : | # a_n*x^n + ... + a_1*x + a_0, in order from least to greatest. | ||
| 240 : | # | ||
| 241 : | # The possibility of overflow or underflow is ignored. Overflow is likely to be | ||
| 242 : | # a bigger problem than underflow. | ||
| 243 : | # | ||
| 244 : | # Do not use this code to guide missiles or control nuclear power plants. | ||
| 245 : | # | ||
| 246 : | sub bkell_real_zeros_finder | ||
| 247 : | { | ||
| 248 : | my @coeffs = @_; | ||
| 249 : | |||
| 250 : | while (@coeffs && $coeffs[0] == 0) { shift @coeffs; } | ||
| 251 : | my $deg = $#coeffs; | ||
| 252 : | |||
| 253 : | if ($deg == -1) { | ||
| 254 : | return ("x"); # zero polynomial is zero everywhere | ||
| 255 : | } elsif ($deg == 0) { | ||
| 256 : | return (); # constant nonzero polynomial has no zeros | ||
| 257 : | } elsif ($deg == 1) { | ||
| 258 : | return (-$coeffs[1]/$coeffs[0]); # linear polynomial has one zero | ||
| 259 : | } | ||
| 260 : | |||
| 261 : | # find critical points | ||
| 262 : | my @derivative = @coeffs; | ||
| 263 : | pop @derivative; | ||
| 264 : | for (my $i = 0; $i < $#derivative; ++$i) { | ||
| 265 : | $derivative[$i] *= @derivative - $i; | ||
| 266 : | } | ||
| 267 : | my @cp = bkell_real_zeros_finder(@derivative); | ||
| 268 : | |||
| 269 : | # if no critical points, we have a monotone function | ||
| 270 : | if (!@cp) { | ||
| 271 : | my ($lb, $rb) = (-1, 1); | ||
| 272 : | my $y1 = bkell_poly_eval($lb, @coeffs); | ||
| 273 : | my $y2 = bkell_poly_eval($rb, @coeffs); | ||
| 274 : | my $sign = ($y1 < $y2 ? +1 : -1); | ||
| 275 : | while ($sign * $y1 > 0) { | ||
| 276 : | $lb *= 2; | ||
| 277 : | $y1 = bkell_poly_eval($lb, @coeffs); | ||
| 278 : | } | ||
| 279 : | while ($sign * $y2 < 0) { | ||
| 280 : | $rb *= 2; | ||
| 281 : | $y2 = bkell_poly_eval($rb, @coeffs); | ||
| 282 : | } | ||
| 283 : | my $guess_x = ($lb + $rb) / 2; | ||
| 284 : | while ($lb < $guess_x && $guess_x < $rb && | ||
| 285 : | (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0) | ||
| 286 : | { | ||
| 287 : | if ( ($y1 < 0 && $guess_y < 0) || ($y1 > 0 && $guess_y > 0) ) { | ||
| 288 : | $lb = $guess_x; | ||
| 289 : | } else { | ||
| 290 : | $rb = $guess_x; | ||
| 291 : | } | ||
| 292 : | $guess_x = ($lb + $rb) / 2; | ||
| 293 : | } | ||
| 294 : | return ($guess_x); | ||
| 295 : | } | ||
| 296 : | |||
| 297 : | my @zeros = (); | ||
| 298 : | |||
| 299 : | # search for a zero to the left of the first critical point | ||
| 300 : | { | ||
| 301 : | my $y = bkell_poly_eval($cp[0], @coeffs); | ||
| 302 : | # we catch this case when we check between critical points: | ||
| 303 : | last if $y == 0; | ||
| 304 : | # not really the limit, but only the sign matters: | ||
| 305 : | my $lim = $coeffs[0] * ($deg % 2 ? -1 : +1); | ||
| 306 : | if ( ($y > 0 && $lim < 0) || ($y < 0 && $lim > 0) ) { | ||
| 307 : | my ($lb, $rb) = (undef, $cp[0]); | ||
| 308 : | my $guess_x = $rb - 10; | ||
| 309 : | if ($guess_x >= 0) { $guess_x = -10; } | ||
| 310 : | while ((!defined $lb || $lb < $guess_x) && $guess_x < $rb && | ||
| 311 : | (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0) | ||
| 312 : | { | ||
| 313 : | if ( ($y > 0 && $guess_y > 0) || ($y < 0 && $guess_y < 0) ) { | ||
| 314 : | $rb = $guess_x; | ||
| 315 : | if (defined $lb) { | ||
| 316 : | $guess_x = ($lb + $guess_x) / 2; | ||
| 317 : | } else { | ||
| 318 : | $guess_x *= 2; | ||
| 319 : | } | ||
| 320 : | } else { | ||
| 321 : | $lb = $guess_x; | ||
| 322 : | $guess_x = ($guess_x + $rb) / 2; | ||
| 323 : | } | ||
| 324 : | } | ||
| 325 : | push @zeros, $guess_x; | ||
| 326 : | } | ||
| 327 : | } | ||
| 328 : | |||
| 329 : | # search for zeros between critical points | ||
| 330 : | for (my $i = 0; $i < $#cp; ++$i) { | ||
| 331 : | my $y1 = bkell_poly_eval($cp[$i], @coeffs); | ||
| 332 : | if ($y1 == 0) { | ||
| 333 : | push @zeros, $cp[$i]; | ||
| 334 : | next; | ||
| 335 : | } | ||
| 336 : | my $y2 = bkell_poly_eval($cp[$i+1], @coeffs); | ||
| 337 : | if ($y2 == 0) { | ||
| 338 : | push @zeros, $cp[$i+1]; | ||
| 339 : | ++$i; | ||
| 340 : | next; | ||
| 341 : | } | ||
| 342 : | next if ($y1 > 0 && $y2 > 0) || ($y1 < 0 && $y2 < 0); | ||
| 343 : | my ($lb, $rb) = ($cp[$i], $cp[$i+1]); | ||
| 344 : | my $guess_x = ($lb + $rb) / 2; | ||
| 345 : | while ($lb < $guess_x && $guess_x < $rb && | ||
| 346 : | (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0) | ||
| 347 : | { | ||
| 348 : | if ( ($y1 > 0 && $guess_y > 0) || ($y1 < 0 && $guess_y < 0) ) { | ||
| 349 : | $lb = $guess_x; | ||
| 350 : | } else { | ||
| 351 : | $rb = $guess_x; | ||
| 352 : | } | ||
| 353 : | $guess_x = ($lb + $rb) / 2; | ||
| 354 : | } | ||
| 355 : | push @zeros, $guess_x unless @zeros && $zeros[-1] == $guess_x; | ||
| 356 : | } | ||
| 357 : | |||
| 358 : | # search for a zero to the right of the last critical point | ||
| 359 : | { | ||
| 360 : | my $y = bkell_poly_eval($cp[-1], @coeffs); | ||
| 361 : | if ($y == 0 && $zeros[-1] != $cp[-1]) { | ||
| 362 : | push @zeros, $cp[-1]; | ||
| 363 : | last; | ||
| 364 : | } | ||
| 365 : | if ( ($y > 0 && $coeffs[0] < 0) || ($y < 0 && $coeffs[0] > 0) ) { | ||
| 366 : | my ($lb, $rb) = ($cp[-1], undef); | ||
| 367 : | my $guess_x = $lb + 10; | ||
| 368 : | if ($guess_x <= 0) { $guess_x = 10; } | ||
| 369 : | while ($lb < $guess_x && (!defined $rb || $guess_x < $rb) && | ||
| 370 : | (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0) | ||
| 371 : | { | ||
| 372 : | if ( ($y > 0 && $guess_y > 0) || ($y < 0 && $guess_y < 0) ) { | ||
| 373 : | $lb = $guess_x; | ||
| 374 : | if (defined $rb) { | ||
| 375 : | $guess_x = ($guess_x + $rb) / 2; | ||
| 376 : | } else { | ||
| 377 : | $guess_x *= 2; | ||
| 378 : | } | ||
| 379 : | } else { | ||
| 380 : | $rb = $guess_x; | ||
| 381 : | $guess_x = ($lb + $guess_x) / 2; | ||
| 382 : | } | ||
| 383 : | } | ||
| 384 : | push @zeros, $guess_x unless @zeros && $zeros[-1] == $guess_x; | ||
| 385 : | } | ||
| 386 : | } | ||
| 387 : | |||
| 388 : | return @zeros; | ||
| 389 : | } | ||
| 390 : | |||
| 391 : | ############################################################################### | ||
| 392 : | # bkell_floor($x) | ||
| 393 : | # | ||
| 394 : | # Returns the floor of $x. Normally this would be done with POSIX::floor, but | ||
| 395 : | # WeBWorK doesn't allow you to use standard modules like POSIX. | ||
| 396 : | # | ||
| 397 : | sub bkell_floor | ||
| 398 : | { | ||
| 399 : | my $x = shift; | ||
| 400 : | my $floor = int $x; | ||
| 401 : | if ($x < 0 && $x != $floor) { $floor -= 1; } | ||
| 402 : | return $floor; | ||
| 403 : | } | ||
| 404 : | |||
| 405 : | ############################################################################### | ||
| 406 : | # bkell_ceil($x) | ||
| 407 : | # | ||
| 408 : | # Returns the ceiling of $x. | ||
| 409 : | # | ||
| 410 : | sub bkell_ceil | ||
| 411 : | { | ||
| 412 : | return -bkell_floor(-shift); | ||
| 413 : | } | ||
| 414 : | |||
| 415 : | ############################################################################### | ||
| 416 : | # bkell_sigfigs($x, $n) | ||
| 417 : | # | ||
| 418 : | # Returns a string containing $x rounded to $n significant figures. | ||
| 419 : | # | ||
| 420 : | sub bkell_sigfigs | ||
| 421 : | { | ||
| 422 : | my ($x, $n) = @_; | ||
| 423 : | |||
| 424 : | if ($x == 0) { return "0".($n > 1 ? "." : "").("0" x ($n-1)); } | ||
| 425 : | |||
| 426 : | my $minus = ""; | ||
| 427 : | if ($x < 0) { | ||
| 428 : | $minus = "-"; | ||
| 429 : | $x = -$x; | ||
| 430 : | } | ||
| 431 : | |||
| 432 : | my $floor_log = bkell_floor(log($x)/log(10)); | ||
| 433 : | |||
| 434 : | if ($floor_log+1 >= $n) { | ||
| 435 : | my $sf = 10**($floor_log-$n+1); | ||
| 436 : | return $minus.(sprintf("%.0f", $x/$sf)*$sf); | ||
| 437 : | } else { | ||
| 438 : | my $digits = $n-$floor_log-1; | ||
| 439 : | return $minus.sprintf("%.${digits}f", $x); | ||
| 440 : | } | ||
| 441 : | } | ||
| 442 : | |||
| 443 : | ############################################################################### | ||
| 444 : | # bkell_125($x) | ||
| 445 : | # | ||
| 446 : | # Returns the value logarithmically nearest $x in the sequence | ||
| 447 : | # ..., -1000, -500, -200, -100, -50, -20, -10, -5, -2, -1, -0.5, -0.2, | ||
| 448 : | # -0.1, -0.05, -0.02, -0.01, ..., 0, ..., 0.01, 0.02, 0.05, 0.1, | ||
| 449 : | # 0.2, 0.5, 1, 2, 5, 10, 20, 50, 100, 200, 500, 1000, ... . | ||
| 450 : | # | ||
| 451 : | sub bkell_125 | ||
| 452 : | { | ||
| 453 : | my $x = shift; | ||
| 454 : | |||
| 455 : | if ($x == 0) { return 0; } | ||
| 456 : | |||
| 457 : | my $sign = +1; | ||
| 458 : | if ($x < 0) { $sign = -1; $x = -$x; } | ||
| 459 : | |||
| 460 : | my $log = log($x)/log(10); | ||
| 461 : | my $characteristic = bkell_floor($log); | ||
| 462 : | my $mantissa = $log - $characteristic; | ||
| 463 : | |||
| 464 : | my $log2 = log(2)/log(10); | ||
| 465 : | my $log5 = log(5)/log(10); | ||
| 466 : | my $m; | ||
| 467 : | if ($mantissa < $log2 / 2) { | ||
| 468 : | $m = 0; | ||
| 469 : | } elsif ($mantissa < ($log2 + $log5) / 2) { | ||
| 470 : | $m = $log2; | ||
| 471 : | } elsif ($mantissa < ($log5 + 1) / 2) { | ||
| 472 : | $m = $log5; | ||
| 473 : | } else { | ||
| 474 : | $m = 1; | ||
| 475 : | } | ||
| 476 : | |||
| 477 : | return $sign * (10 ** ($characteristic + $m)); | ||
| 478 : | } | ||
| 479 : | |||
| 480 : | ############################################################################### | ||
| 481 : | # bkell_list_random_selection($n, @list) | ||
| 482 : | # | ||
| 483 : | # Returns a selection of $n distinct elements of @list. This is like | ||
| 484 : | # list_random_multi_uniq in freemanMacros.pl, except that this function will | ||
| 485 : | # always return the elements in the same order as they appear in @list. | ||
| 486 : | # | ||
| 487 : | sub bkell_list_random_selection | ||
| 488 : | { | ||
| 489 : | my $n = int abs shift; # so strange $n won't cause infinite loop | ||
| 490 : | my @list = @_; | ||
| 491 : | |||
| 492 : | my $needed = $n; | ||
| 493 : | my @result = (); | ||
| 494 : | while ($needed && @list) { | ||
| 495 : | if (random(1, scalar @list) <= $needed) { | ||
| 496 : | push @result, shift @list; | ||
| 497 : | --$needed; | ||
| 498 : | } else { | ||
| 499 : | shift @list; | ||
| 500 : | } | ||
| 501 : | } | ||
| 502 : | |||
| 503 : | return @result; | ||
| 504 : | } | ||
| 505 : | |||
| 506 : | ############################################################################### | ||
| 507 : | # bkell_graph_axis($a, $b) | ||
| 508 : | # | ||
| 509 : | # Returns a list ($min, $max, $step), where $min <= $a, $max >= $b, $step is a | ||
| 510 : | # power of 10, $min and $max are multiples of $step, abs($min) <= 9*$step, and | ||
| 511 : | # abs($max) <= 9*$step. Useful for deciding bounds for the axis of a graph. For | ||
| 512 : | # example, to make a graph axis that can handle values between $a and $b, call | ||
| 513 : | # bkell_graph_axis, and then set the minimum value of the axis to $min and the | ||
| 514 : | # maximum to $max, and put tick marks every $step units. | ||
| 515 : | # | ||
| 516 : | sub bkell_graph_axis | ||
| 517 : | { | ||
| 518 : | my ($a, $b) = @_; | ||
| 519 : | |||
| 520 : | if ($a > $b) { ($a, $b) = ($b, $a); } | ||
| 521 : | |||
| 522 : | my $s1 = 0; | ||
| 523 : | my $s2 = 0; | ||
| 524 : | |||
| 525 : | if ($a != 0) { $s1 = bkell_floor(log(abs $a)/log(10)); } | ||
| 526 : | if ($b != 0) { $s2 = bkell_floor(log(abs $b)/log(10)); } | ||
| 527 : | |||
| 528 : | my $s = ($s1 > $s2 ? $s1 : $s2); | ||
| 529 : | |||
| 530 : | $step = 10**$s; | ||
| 531 : | $min = $step * bkell_floor($a/$step); | ||
| 532 : | $max = $step * bkell_ceil($b/$step); | ||
| 533 : | |||
| 534 : | return ($min, $max, $step); | ||
| 535 : | } | ||
| 536 : | |||
| 537 : | ####################################################################### EOF ### |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |