Parent Directory
| 
Revision Log
another setup script test (changed #! lines)
1 #!/usr/local/bin/webwork-perl 2 # 3 # 4 # 5 # 6 # 7 # 8 use strict; 9 10 # Methods for evaluating units in answers 11 package Units; 12 13 # These subroutines return a unit hash. 14 # A unit hash has the entries 15 # factor => number number can be any real number 16 # m => power power is a signed integer 17 # k => power 18 # s => power 19 # perhaps other fundamental units will added later as well. 20 21 22 my %fundamental_units = ('factor' => 1, 23 'm' => 0, 24 'k' => 0, 25 's' => 0 26 ); 27 28 my %known_units = ('m' => { 29 'factor' => 1, 30 'm' => 1, 31 }, 32 'k' => { 33 'factor' => 1, 34 'k' => 1, 35 }, 36 's' => { 37 'factor' => 1, 38 's' => 1 39 }, 40 # m -- meters 41 # cm -- centimeters 42 # km -- kilometers 43 # mm -- millimeters 44 'cm' => { 45 'factor' => 0.01, 46 'm' => 1, 47 }, 48 'mm' => { 49 'factor' => 0.001, 50 'm' => 1, 51 }, 52 'km' => { 53 'factor' => 1000, 54 'm' => 1, 55 }, 56 # g -- grams 57 # kg -- kilograms 58 'kg' => { 59 'factor' => 1, 60 'k' => 1, 61 }, 62 'g' => { 63 'factor' => 0.001, 64 'k' => 1, 65 }, 66 # s -- seconds 67 # min -- minutes 68 # hr -- hours 69 # days -- days 70 # yr -- years -- 365 days in a year 71 'min' => { 72 'factor' => 60, 73 's' => 1 74 }, 75 'hr' => { 76 'factor' => 3600, 77 's' => 1 78 }, 79 'days' => { 80 'factor' => 86400, 81 's' => 1 82 }, 83 'yr' => { 84 'factor' => 31536000, 85 's' => 1 86 }, 87 # nt -- newtons (=kg*m/s^2) 88 # ?? -- dynes (=g*cm/s^2 = nt/10^5) 89 'nt' => { 90 'factor' => 1, 91 'm' => 1, 92 'k' => 1, 93 's' => -2 94 }, 95 # 96 # j -- joules (= nt*m = kg*m^2/s^2) 97 # ?? -- ergs (=dyne*cm = g*cm^2/s^2 = j/10^7) 98 # cal -- calorie (=??) 99 'j' => { 100 'factor' => 1, 101 'm' => 2, 102 'k' => 1, 103 's' => -2 104 }, 105 106 107 # w -- watt (=j/s = kg*m^2/s^3) 108 # kw -- kilowatt 109 'w' => { 110 'factor' => 1, 111 'm' => 2, 112 'k' => 1, 113 's' => -3 114 }, 115 'kw' => { 116 'factor' => 1000, 117 'm' => 2, 118 'k' => 1, 119 's' => -3 120 }, 121 # l -- liters 122 # ml -- milliliters 123 # cc -- cubic centermeters 124 'cc' => { 125 'factor' => 10**(-6), 126 'm' => 3, 127 }, 128 'ml' => { 129 'factor' => 10**(-6), 130 'm' => 3, 131 }, 132 'l' => { 133 'factor' => 10**(-3), 134 'm' => 3, 135 }, 136 ); 137 138 139 140 sub process_unit { 141 142 my $string = shift; 143 144 #split the string into numerator and denominator --- the separator is / 145 my ($numerator,$denominator) = split(m{/}, $string); 146 my %numerator_hash = process_term($numerator); 147 my %denominator_hash = process_term($denominator); 148 149 my %unit_hash = ('factor' => 1, 150 'm' => 0, 151 'k' => 0, 152 's' => 0 153 ); 154 my $u; 155 foreach $u (keys %unit_hash) { 156 if ( $u eq 'factor' ) { 157 $unit_hash{$u} = $numerator_hash{$u}/$denominator_hash{$u}; # calculate the correction factor for the unit 158 } else { 159 160 $unit_hash{$u} = $numerator_hash{$u} - $denominator_hash{$u}; # calculate the power of the fundamental unit in the unit 161 } 162 } 163 # return a unit hash. 164 return(%unit_hash); 165 } 166 167 sub process_term { 168 my $string = shift; 169 my %unit_hash = %fundamental_units; 170 if ($string) { 171 172 #split the numerator or denominator into factors -- the separators are * 173 174 my @factors = split(/\*/, $string); 175 176 my $f; 177 foreach $f (@factors) { 178 my %factor_hash = process_factor($f); 179 180 my $u; 181 foreach $u (keys %unit_hash) { 182 if ( $u eq 'factor' ) { 183 $unit_hash{$u} = $unit_hash{$u} * $factor_hash{$u}; # calculate the correction factor for the unit 184 } else { 185 186 $unit_hash{$u} = $unit_hash{$u} + $factor_hash{$u}; # calculate the power of the fundamental unit in the unit 187 } 188 } 189 } 190 } 191 #returns a unit hash. 192 #print "process_term returns", %unit_hash, "\n"; 193 return(%unit_hash); 194 } 195 196 197 sub process_factor { 198 my $string = shift; 199 #split the factor into unit and powers 200 201 my ($unit_name,$power) = split(/\^/, $string); 202 $power = 1 unless defined($power); 203 my %unit_hash = %fundamental_units; 204 205 if ( defined( $known_units{$unit_name} ) ) { 206 207 my %unit_name_hash = %{$known_units{$unit_name}}; # $reference_units contains all of the known units. 208 my $u; 209 foreach $u (keys %unit_hash) { 210 if ( $u eq 'factor' ) { 211 $unit_hash{$u} = $unit_name_hash{$u}**$power; # calculate the correction factor for the unit 212 } else { 213 my $fundamental_unit = $unit_name_hash{$u}; 214 $fundamental_unit = 0 unless defined($fundamental_unit); # a fundamental unit which doesn't appear in the unit need not be defined explicitly 215 $unit_hash{$u} = $fundamental_unit*$power; # calculate the power of the fundamental unit in the unit 216 } 217 } 218 } else { 219 die "UNIT ERROR Unrecognizable unit: |$unit_name|"; 220 } 221 %unit_hash; 222 } 223 224 sub evaluate_units { 225 my $unit = shift; 226 my %output = eval(q{process_unit( $unit)}); 227 %output = %fundamental_units if $@; 228 %output; 229 } 230 231 package main; 232 sub NUM_CMP { # low level numeric compare 233 my ($correctAnswer,$tol,$format,$mode,$tolType,$zeroLevel,$zeroLevelTol) = @_; 234 # $mode is 'std', 'strict', 'arith', or 'frac' 235 # $tolType is 'rel' or 'abs'. Default is 'rel' 236 my $formattedCorrectAnswer = prfmt($correctAnswer,$format ); 237 my $answer_evaluator = sub { 238 my $in = shift @_; 239 my $PGanswerMessage = ''; 240 my ($inVal,$correctVal); 241 $inVal = ''; 242 $correctAnswer = &math_constants($correctAnswer); 243 my $formattedSubmittedAnswer = ''; 244 $@=''; 245 if ($correctAnswer =~ /\S/) {$correctVal = eval($correctAnswer);} else { $@ = ' ';} 246 if ($@ or not is_a_number($correctVal)) { ##error message from eval or above 247 $formattedSubmittedAnswer = $@; 248 $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer); 249 $PGanswerMessage = 'Tell your professor that there is an error in this problem'; 250 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 251 } 252 $in = &math_constants($in); 253 254 MODE_CASE: { ## bare block for "case" statement 255 if ($mode eq 'std') { 256 last MODE_CASE; 257 } 258 if ($mode eq 'strict') { 259 unless (is_a_number($in)) { 260 $PGanswerMessage = 'You must enter a number, e.g. -6, 5.3, or 6.12E-3'; 261 $formattedSubmittedAnswer = 'Incorrect number format'; 262 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 263 } 264 last MODE_CASE; 265 } 266 if ($mode eq 'arith') { 267 unless (is_an_arithmetic_expression($in)) { 268 $PGanswerMessage = 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2'; 269 $formattedSubmittedAnswer = 'Not an arithmetic expression'; 270 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 271 } 272 last MODE_CASE; 273 } 274 if ($mode eq 'frac') { 275 unless (is_a_fraction($in)) { 276 $PGanswerMessage = 'You must enter a number or fraction , e.g. -6 or 7/13'; 277 $formattedSubmittedAnswer = 'Not a number or fraction'; 278 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 279 } 280 last MODE_CASE; 281 } 282 $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism'; 283 $formattedSubmittedAnswer = $in; 284 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 285 } # end of MODE_CASES bare block 286 287 $@=''; 288 if ($in =~ /\S/) {$inVal = eval($in);} else { $@ = ' ';} 289 if ($@) { ##error message from eval or above 290 $formattedSubmittedAnswer = $@; 291 $formattedSubmittedAnswer =clean_up_error_msg($formattedSubmittedAnswer); 292 $PGanswerMessage = 'There is a syntax error in your answer'; 293 return (0,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 294 } 295 else {$formattedSubmittedAnswer = prfmt($inVal,$format);} 296 297 unless ($tolType eq 'abs') { 298 if ( abs($correctVal) <= $zeroLevel) {$tol = $zeroLevelTol;} ## want $tol to be non zero 299 else {$tol = abs($tol*$correctVal);} 300 } 301 my $correctQ =0; 302 my $is_a_number = is_a_number($inVal); 303 $correctQ = 1 if (($is_a_number) and 304 (abs( $inVal - $correctVal ) <= $tol)); 305 if ($@) {$PGanswerMessage = 'There is a syntax error in your answer';} 306 elsif (not $is_a_number){$PGanswerMessage = 'Your answer does not evaluate to a number';} 307 ($correctQ,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 308 }; 309 $answer_evaluator; 310 } 311 ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT. 312 313 314 sub is_a_number { 315 my ($num) = @_; 316 $num =~ s/^\s*//; ## remove initial spaces 317 $num =~ s/\s*$//; ## remove trailing spaces 318 my $is_a_number = 0; 319 ## the following is copied from the online perl manual 320 if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){$is_a_number = 1;} 321 $is_a_number; 322 } 323 324 sub is_a_fraction { 325 326 ## does not test for validity, just for allowed characters 327 my ($exp) = @_; 328 my $is_a_fraction = 0; 329 if ($exp =~ /^[\/\d\.Ee\s]*$/){$is_a_fraction = 1;} 330 $is_a_fraction; 331 } 332 333 sub is_an_arithmetic_expression { 334 335 ## does not test for validity, just for allowed characters 336 my ($exp) = @_; 337 my $is_an_arithmetic_expression = 0; 338 if ($exp =~ /^[+\-*\/\^\(\)\s\d\.Ee]*$/){$is_an_arithmetic_expression = 1;} 339 $is_an_arithmetic_expression; 340 } 341 342 343 sub math_constants { 344 my($in) = @_; 345 $in =~s/\bpi\b/(4*atan2(1,1))/ge; 346 $in =~s/\be\b/(exp(1))/ge; 347 $in =~s/\^/**/g; 348 $in; 349 } 350 351 sub clean_up_error_msg 352 { 353 my $msg = $_[0]; 354 $msg =~ s/at.*line [\d]*//g; 355 $msg =~ s/called//g; 356 $msg =~ s/&main:://g; 357 $msg =~ s/chunk [\d]*//g; 358 $msg; 359 } 360 361 sub prfmt { 362 my($number,$format) = @_; # attention, the order of format and number are reversed 363 my $out; 364 if ($format) {$out = sprintf($format, $number);} 365 else {$out = $number;} 366 $out; 367 } 368 my $numRelPercentTolDefault = 1; 369 #### end subroutines 370 sub numerical_compare_with_units { 371 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 372 my %options = @_; 373 # handle the defaults 374 # I can't guarantee what will happen if you reset 'mode' to anything other than 'strict' or 'arith'. 375 # the routine for separating the numerical part of the answer from the units will probably break. 376 $options{'mode'} = 'arith' unless defined( $options{'mode'} ); 377 378 $options{'format'} = '%0.5e' unless defined( $options{'mode'} ); 379 $options{'zeroLevel'} = 1E-14 unless defined( $options{'zeroLevel'} ); 380 $options{'zeroLevelTol'} = 1E-12 unless defined( $options{'zeroLevelTol'} ); 381 my ($tol, $tolerance_mode); 382 if ( defined($options{'tol'}) ) { 383 $tol = $options{'tol'}; 384 $tolerance_mode = 'abs'; 385 } elsif ( defined($options{'reltol'}) ) { 386 $tol = .01*$options{'reltol'}; 387 $tolerance_mode = 'rel'; 388 389 } else { #the default is a relative tolerance 390 $tol = 0.01*$numRelPercentTolDefault; 391 $tolerance_mode = 'rel'; 392 }; 393 # THE NUMERICAL PART CANNOT CONTAIN ANY LETTERS (EXCEPT E OR e). It can be an arithmetic expression. 394 # Prepare the correct answer: 395 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^\s*([^a-df-zA-DF-Z]*)\s+([^\s]*)\s*/; 396 my %correct_units = Units::evaluate_units($correct_units); 397 $correct_num_answer = $correct_num_answer * $correct_units{'factor'}; 398 399 400 my $ans_evaluator = sub { 401 my $ans = shift; 402 my @output; 403 my ($num_answer, $units); 404 unless ( $ans =~ /^\s*([^a-df-zA-DF-Z]*)\s+([^\s]*)\s*/ ) { 405 # there is an error reading the input 406 my $correctQ = 0; # the answer is not correct; 407 my $formattedCorrectAnswer = $correct_answer; 408 my $formattedSubmittedAnswer = $ans; 409 my $PGanswerMessage = "The answer \"$ans\" could not be interpreted as a number or an arithmetic expression followed by a unit specification. Your answer must contain units."; 410 @output = ($correctQ,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 411 412 } else { 413 # we have been able to parse the answer into a numerical part and a unit part 414 $num_answer = $1; 415 $units = $2; 416 my %units = Units::evaluate_units($units); 417 my $units_match = 1; 418 my $fund_unit; 419 foreach $fund_unit (keys %correct_units) { 420 next if $fund_unit eq 'factor'; 421 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit}; 422 } 423 424 if ($units_match) { 425 # units are ok. Evaluate the numerical part of the answer 426 $tol = $tol * $correct_units{'factor'}/$units{'factor'} if $tolerance_mode eq 'abs'; # the tolerance is in the units specified by the instructor. 427 my $numerical_answer_evaluator =NUM_CMP($correct_num_answer/$units{'factor'}, $tol, $options{'format'}, 428 $options{'mode'}, $tolerance_mode, $options{'zeroLevel'} ,$options{'zeroLevelTol'} ); 429 # because num_answer may contain an arithmetic expression rather than a number we can't multiply it by the $units{'factor'} 430 # instead we divide the correct answer by this amount; 431 # this is also why the numerical_answer_evaluator is not defined outside this subroutine. 432 @output = &$numerical_answer_evaluator($num_answer); 433 #now we need to doctor the correct answer in order to add units to it and correct for the division we did before 434 $output[1] = prfmt( $output[1]*$units{'factor'}, $options{'format'} ) . " $correct_units"; 435 # we also need to doctor the submitted answer to get it back in its original format. 436 $output[2] = prfmt( $output[2]*$units{'factor'}, $options{'format'}) . " $units"; 437 438 } else { 439 # units are not ok ($correctQ,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 440 my $correctQ = 0; # the answer is not correct; 441 my $formattedCorrectAnswer = $correct_answer; 442 my $formattedSubmittedAnswer = $ans; 443 my $PGanswerMessage = "There is an error in the units for this answer."; 444 @output = ($correctQ,$formattedCorrectAnswer,$formattedSubmittedAnswer,$PGanswerMessage); 445 446 } 447 } 448 @output; 449 }; 450 $ans_evaluator; 451 } 452 #my ($correctAnswer,$tol,$format,$mode,$tolType,$zeroLevel,$zeroLevelTol) = @_; 453 454 #my $ans_eval = NUM_CMP(34, .01, "%0.3f","arith", "rel",10E-12,10E-12); 455 my $input = "34e-04 / (45+34) cm^3/s^2"; 456 457 print "evaluating $input:\n"; 458 my $ans_eval = numerical_compare_with_units("34 m/s^2", 'tol'=>.15, 'format'=>'%5.6e'); 459 print ">>>$@>>>\n" if $@; 460 461 print "The answer is\n", join("\n", &$ans_eval("3410 cm/s^2") ); 462 463
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |