[npl] / trunk / NationalProblemLibrary / WHFreeman / Rogawski_Calculus_Early_Transcendentals_Second_Edition / macros / freemanMacros.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# Annotation of /trunk/NationalProblemLibrary/WHFreeman/Rogawski_Calculus_Early_Transcendentals_Second_Edition/macros/freemanMacros.pl

 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 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 ###