[system] / trunk / webwork / system / courseScripts / PGanswermacros.pl Repository:
ViewVC logotype

Diff of /trunk/webwork/system/courseScripts/PGanswermacros.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 53 Revision 54
… …
51(the preview_latex_string is optional). The output hash is now being created 51(the preview_latex_string is optional). The output hash is now being created
52with the AnswerHash package "class", which is located at the end of this file. 52with the AnswerHash package "class", which is located at the end of this file.
53This class is currently just a wrapper for the hash, but this might change in 53This class is currently just a wrapper for the hash, but this might change in
54the future as new capabilities are added. 54the future as new capabilities are added.
55 55
56 score => $correctQ, 56 score => $correctQ,
57 correct_ans => $originalCorrEqn, 57 correct_ans => $originalCorrEqn,
58 student_ans => $modified_student_ans 58 student_ans => $modified_student_ans
59 original_student_ans => $original_student_answer, 59 original_student_ans => $original_student_answer,
60 ans_message => $PGanswerMessage, 60 ans_message => $PGanswerMessage,
61 type => 'typeString', 61 type => 'typeString',
62 preview_text_string => $preview_text_string, 62 preview_text_string => $preview_text_string,
63 preview_latex_string => $preview_latex_string 63 preview_latex_string => $preview_latex_string
64 64
65 65
66 $ans_hash{score} -- a number between 0 and 1 indicating 66 $ans_hash{score} -- a number between 0 and 1 indicating
67 whether the answer is correct. Fractions 67 whether the answer is correct. Fractions
… …
137 # import defaults 137 # import defaults
138 # these are now imported from the %envir variable 138 # these are now imported from the %envir variable
139 $numRelPercentTolDefault = $main::numRelPercentTolDefault; 139 $numRelPercentTolDefault = $main::numRelPercentTolDefault;
140 $numZeroLevelDefault = $main::numZeroLevelDefault; 140 $numZeroLevelDefault = $main::numZeroLevelDefault;
141 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault; 141 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault;
142 $numAbsTolDefault = $main::numAbsTolDefault; 142 $numAbsTolDefault = $main::numAbsTolDefault;
143 $numFormatDefault = $main::numFormatDefault; 143 $numFormatDefault = $main::numFormatDefault;
144 144
145 $functRelPercentTolDefault = $main::functRelPercentTolDefault; 145 $functRelPercentTolDefault = $main::functRelPercentTolDefault;
146 $functZeroLevelDefault = $main::functZeroLevelDefault; 146 $functZeroLevelDefault = $main::functZeroLevelDefault;
147 $functZeroLevelTolDefault = $main::functZeroLevelTolDefault; 147 $functZeroLevelTolDefault = $main::functZeroLevelTolDefault;
148 $functAbsTolDefault = $main::functAbsTolDefault; 148 $functAbsTolDefault = $main::functAbsTolDefault;
149 $functNumOfPoints = $main::functNumOfPoints; 149 $functNumOfPoints = $main::functNumOfPoints;
150 $functVarDefault = $main::functVarDefault; 150 $functVarDefault = $main::functVarDefault;
151 $functLLimitDefault = $main::functLLimitDefault; 151 $functLLimitDefault = $main::functLLimitDefault;
152 $functULimitDefault = $main::functULimitDefault; 152 $functULimitDefault = $main::functULimitDefault;
153 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration; 153 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration;
154 154
155 155
156 156
157} 157}
158 158
… …
266 formatting will be used; this will show 'arbitrary' precision 266 formatting will be used; this will show 'arbitrary' precision
267 floating points. 267 floating points.
268 268
269Default Values (As of 7/24/2000) (Option -- Variable Name -- Value) 269Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
270 270
271 Format -- $numFormatDefault -- "%0.5f#" 271 Format -- $numFormatDefault -- "%0.5f#"
272 Relative Tolerance -- $numRelPercentTolDefault -- .1 272 Relative Tolerance -- $numRelPercentTolDefault -- .1
273 Absolute Tolerance -- $numAbsTolDefault -- .001 273 Absolute Tolerance -- $numAbsTolDefault -- .001
274 Zero Level -- $numZeroLevelDefault -- 1E-14 274 Zero Level -- $numZeroLevelDefault -- 1E-14
275 Zero Level Tolerance -- $numZeroLevelTolDefault -- 1E-12 275 Zero Level Tolerance -- $numZeroLevelTolDefault -- 1E-12
276 276
277=cut 277=cut
278 278
279=head3 "mode"_num_cmp() functions 279=head3 "mode"_num_cmp() functions
… …
289 std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel) OR 289 std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel) OR
290 std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol) 290 std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol)
291 291
292 $correctAnswer -- the correct answer 292 $correctAnswer -- the correct answer
293 $relPercentTol -- the tolerance, as a percentage (optional) 293 $relPercentTol -- the tolerance, as a percentage (optional)
294 $format -- the format of the displayed answer (optional) 294 $format -- the format of the displayed answer (optional)
295 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies (optional) 295 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies (optional)
296 $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero (optional) 296 $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero (optional)
297 297
298 std_num_cmp() uses standard mode (arithmetic operations and elementary 298 std_num_cmp() uses standard mode (arithmetic operations and elementary
299 functions allowed) and relative tolerance. Options are specified by 299 functions allowed) and relative tolerance. Options are specified by
300 one or more parameters. Note that if you wish to set an option which 300 one or more parameters. Note that if you wish to set an option which
… …
302 302
303 std_num_cmp_abs($correctAnswer) OR 303 std_num_cmp_abs($correctAnswer) OR
304 std_num_cmp_abs($correctAnswer, $absTol) OR 304 std_num_cmp_abs($correctAnswer, $absTol) OR
305 std_num_cmp_abs($correctAnswer, $absTol, $format) 305 std_num_cmp_abs($correctAnswer, $absTol, $format)
306 306
307 $correctAnswer -- the correct answer 307 $correctAnswer -- the correct answer
308 $absTol -- an absolute tolerance (optional) 308 $absTol -- an absolute tolerance (optional)
309 $format -- the format of the displayed answer (optional) 309 $format -- the format of the displayed answer (optional)
310 310
311 std_num_cmp_abs() uses standard mode and absolute tolerance. Options 311 std_num_cmp_abs() uses standard mode and absolute tolerance. Options
312 are set as with std_num_cmp(). Note that $zeroLevel and $zeroLevelTol 312 are set as with std_num_cmp(). Note that $zeroLevel and $zeroLevelTol
313 do not apply with absolute tolerance. 313 do not apply with absolute tolerance.
314 314
315 std_num_cmp_list($relPercentTol, $format, @answerList) 315 std_num_cmp_list($relPercentTol, $format, @answerList)
316 316
317 $relPercentTol -- the tolerance, as a percentage 317 $relPercentTol -- the tolerance, as a percentage
318 $format -- the format of the displayed answer(s) 318 $format -- the format of the displayed answer(s)
319 @answerList -- a list of one or more correct answers 319 @answerList -- a list of one or more correct answers
320 320
321 std_num_cmp_list() uses standard mode and relative tolerance. There 321 std_num_cmp_list() uses standard mode and relative tolerance. There
322 is no way to set $zeroLevel or $zeroLevelTol. Note that no 322 is no way to set $zeroLevel or $zeroLevelTol. Note that no
… …
352 ANS( std_num_cmp( $answer) ) or ANS( std_num_cmp( $answer,.01 )) -- 352 ANS( std_num_cmp( $answer) ) or ANS( std_num_cmp( $answer,.01 )) --
353 The student answer can contain elementary functions, e.g. sin(.3+pi/2) 353 The student answer can contain elementary functions, e.g. sin(.3+pi/2)
354 354
355=cut 355=cut
356 356
357sub std_num_cmp { # compare numbers allowing use of elementary functions 357sub std_num_cmp { # compare numbers allowing use of elementary functions
358 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 358 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
359 359
360 my %options = ( 'tolerance' => $relPercentTol, 360 my %options = ( 'tolerance' => $relPercentTol,
361 'format' => $format, 361 'format' => $format,
362 'zeroLevel' => $zeroLevel, 362 'zeroLevel' => $zeroLevel,
… …
364 ); 364 );
365 365
366 set_default_options( \%options, 366 set_default_options( \%options,
367 'tolType' => 'relative', 367 'tolType' => 'relative',
368 'tolerance' => $numRelPercentTolDefault, 368 'tolerance' => $numRelPercentTolDefault,
369 'mode' => 'std', 369 'mode' => 'std',
370 'format' => $numFormatDefault, 370 'format' => $numFormatDefault,
371 'relTol' => $numRelPercentTolDefault, 371 'relTol' => $numRelPercentTolDefault,
372 'zeroLevel' => $numZeroLevelDefault, 372 'zeroLevel' => $numZeroLevelDefault,
373 'zeroLevelTol' => $numZeroLevelTolDefault, 373 'zeroLevelTol' => $numZeroLevelTolDefault,
374 'debug' => 0, 374 'debug' => 0,
375 ); 375 );
376 376
… …
379 379
380## Similar to std_num_cmp but accepts a list of numbers in the form 380## Similar to std_num_cmp but accepts a list of numbers in the form
381## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...) 381## std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
382## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default 382## format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
383## You must enter a format and tolerance 383## You must enter a format and tolerance
384sub std_num_cmp_list { 384sub std_num_cmp_list {
385 my ( $relPercentTol, $format, @answerList) = @_; 385 my ( $relPercentTol, $format, @answerList) = @_;
386 386
387 my %options = ( 'tolerance' => $relPercentTol, 387 my %options = ( 'tolerance' => $relPercentTol,
388 'format' => $format, 388 'format' => $format,
389 ); 389 );
390 390
391 set_default_options( \%options, 391 set_default_options( \%options,
392 'tolType' => 'relative', 392 'tolType' => 'relative',
393 'tolerance' => $numRelPercentTolDefault, 393 'tolerance' => $numRelPercentTolDefault,
… …
401 401
402 num_cmp(\@answerList, %options); 402 num_cmp(\@answerList, %options);
403 403
404} 404}
405 405
406sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance 406sub std_num_cmp_abs { # compare numbers allowing use of elementary functions with absolute tolerance
407 my ( $correctAnswer, $absTol, $format) = @_; 407 my ( $correctAnswer, $absTol, $format) = @_;
408 my %options = ( 'tolerance' => $absTol, 408 my %options = ( 'tolerance' => $absTol,
409 'format' => $format); 409 'format' => $format
410 );
410 411
411 set_default_options (\%options, 412 set_default_options (\%options,
412 'tolType' => 'absolute', 413 'tolType' => 'absolute',
413 'tolerance' => $absTol, 414 'tolerance' => $absTol,
414 'mode' => 'std', 415 'mode' => 'std',
… …
421 num_cmp([$correctAnswer], %options); 422 num_cmp([$correctAnswer], %options);
422} 423}
423 424
424## See std_num_cmp_list for usage 425## See std_num_cmp_list for usage
425 426
426sub std_num_cmp_abs_list { 427sub std_num_cmp_abs_list {
427 my ( $absTol, $format, @answerList ) = @_; 428 my ( $absTol, $format, @answerList ) = @_;
428 429
429 my %options = ( 'tolerance' => $absTol, 430 my %options = ( 'tolerance' => $absTol,
430 'format' => $format, 431 'format' => $format,
431 ); 432 );
… …
442 443
443 num_cmp(\@answerList, %options); 444 num_cmp(\@answerList, %options);
444 445
445} 446}
446 447
447sub frac_num_cmp { # only allow fractions and numbers as submitted answer 448sub frac_num_cmp { # only allow fractions and numbers as submitted answer
448 449
449 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 450 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
450 451
451 my %options = ( 'tolerance' => $relPercentTol, 452 my %options = ( 'tolerance' => $relPercentTol,
452 'format' => $format, 453 'format' => $format,
… …
461 'format' => $numFormatDefault, 462 'format' => $numFormatDefault,
462 'zeroLevel' => $numZeroLevelDefault, 463 'zeroLevel' => $numZeroLevelDefault,
463 'zeroLevelTol' => $numZeroLevelTolDefault, 464 'zeroLevelTol' => $numZeroLevelTolDefault,
464 'relTol' => $numRelPercentTolDefault, 465 'relTol' => $numRelPercentTolDefault,
465 'debug' => 0, 466 'debug' => 0,
466 ); 467 );
467 468
468 num_cmp([$correctAnswer], %options); 469 num_cmp([$correctAnswer], %options);
469} 470}
470 471
471## See std_num_cmp_list for usage 472## See std_num_cmp_list for usage
472sub frac_num_cmp_list { 473sub frac_num_cmp_list {
473 my ( $relPercentTol, $format, @answerList ) = @_; 474 my ( $relPercentTol, $format, @answerList ) = @_;
474 475
475 my %options = ( 'tolerance' => $relPercentTol, 476 my %options = ( 'tolerance' => $relPercentTol,
476 'format' => $format 477 'format' => $format
477 ); 478 );
… …
486 'relTol' => $numRelPercentTolDefault, 487 'relTol' => $numRelPercentTolDefault,
487 'debug' => 0, 488 'debug' => 0,
488 ); 489 );
489 490
490 num_cmp(\@answerList, %options); 491 num_cmp(\@answerList, %options);
491
492} 492}
493 493
494
495sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance 494sub frac_num_cmp_abs { # only allow fraction expressions as submitted answer with absolute tolerance
496 my ( $correctAnswer, $absTol, $format ) = @_; 495 my ( $correctAnswer, $absTol, $format ) = @_;
497 496
498 my %options = ( 'tolerance' => $absTol, 497 my %options = ( 'tolerance' => $absTol,
499 'format' => $format 498 'format' => $format
500 ); 499 );
501 500
502 set_default_options (\%options, 501 set_default_options (\%options,
503 'tolType' => 'absolute', 502 'tolType' => 'absolute',
504 'tolerance' => $absTol, 503 'tolerance' => $absTol,
505 'mode' => 'frac', 504 'mode' => 'frac',
506 'format' => $numFormatDefault, 505 'format' => $numFormatDefault,
507 'zeroLevel' => 0, 506 'zeroLevel' => 0,
508 'zeroLevelTol' => 0, 507 'zeroLevelTol' => 0,
509 'debug' => 0, 508 'debug' => 0,
510 ); 509 );
510
511 num_cmp([$correctAnswer], %options); 511 num_cmp([$correctAnswer], %options);
512
513
514} 512}
515 513
516## See std_num_cmp_list for usage 514## See std_num_cmp_list for usage
517sub frac_num_cmp_abs_list { 515sub frac_num_cmp_abs_list {
518 my ( $absTol, $format, @answerList ) = @_; 516 my ( $absTol, $format, @answerList ) = @_;
519 517
520 my %options = ( 'tolerance' => $absTol, 518 my %options = ( 'tolerance' => $absTol,
521 'format' => $format 519 'format' => $format
522 ); 520 );
523 521
524 set_default_options (\%options, 522 set_default_options (\%options,
525 'tolType' => 'absolute', 523 'tolType' => 'absolute',
526 'tolerance' => $absTol, 524 'tolerance' => $absTol,
527 'mode' => 'frac', 525 'mode' => 'frac',
… …
533 531
534 num_cmp(\@answerList, %options); 532 num_cmp(\@answerList, %options);
535} 533}
536 534
537 535
538sub arith_num_cmp { # only allow arithmetic expressions as submitted answer 536sub arith_num_cmp { # only allow arithmetic expressions as submitted answer
539 537
540 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 538 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
541 539
542 my %options = ( 'tolerance' => $relPercentTol, 540 my %options = ( 'tolerance' => $relPercentTol,
543 'format' => $format, 541 'format' => $format,
544 'zeroLevel' => $zeroLevel, 542 'zeroLevel' => $zeroLevel,
545 'zeroLevelTol' => $zeroLevelTol 543 'zeroLevelTol' => $zeroLevelTol
546 ); 544 );
547 545
546 set_default_options( \%options,
547 'tolType' => 'relative',
548 'tolerance' => $relPercentTol,
549 'mode' => 'arith',
550 'format' => $numFormatDefault,
551 'zeroLevel' => $numZeroLevelDefault,
552 'zeroLevelTol' => $numZeroLevelTolDefault,
553 'relTol' => $numRelPercentTolDefault,
554 'debug' => 0,
555 );
556
557 num_cmp([$correctAnswer], %options);
558}
559
560## See std_num_cmp_list for usage
561sub arith_num_cmp_list {
562 my ( $relPercentTol, $format, @answerList ) = @_;
563
564 my %options = ( 'tolerance' => $relPercentTol,
565 'format' => $format,
566 );
567
548 set_default_options( \%options, 568 set_default_options( \%options,
549 'tolType' => 'relative', 569 'tolType' => 'relative',
550 'tolerance' => $relPercentTol, 570 'tolerance' => $relPercentTol,
551 'mode' => 'arith', 571 'mode' => 'arith',
552 'format' => $numFormatDefault, 572 'format' => $numFormatDefault,
553 'zeroLevel' => $numZeroLevelDefault, 573 'zeroLevel' => $numZeroLevelDefault,
554 'zeroLevelTol' => $numZeroLevelTolDefault, 574 'zeroLevelTol' => $numZeroLevelTolDefault,
555 'relTol' => $numRelPercentTolDefault, 575 'relTol' => $numRelPercentTolDefault,
556 'debug' => 0, 576 'debug' => 0,
557 ); 577 );
558
559 num_cmp([$correctAnswer], %options);
560}
561
562## See std_num_cmp_list for usage
563sub arith_num_cmp_list {
564 my ( $relPercentTol, $format, @answerList ) = @_;
565
566 my %options = ( 'tolerance' => $relPercentTol,
567 'format' => $format,
568 );
569
570 set_default_options( \%options,
571 'tolType' => 'relative',
572 'tolerance' => $relPercentTol,
573 'mode' => 'arith',
574 'format' => $numFormatDefault,
575 'zeroLevel' => $numZeroLevelDefault,
576 'zeroLevelTol' => $numZeroLevelTolDefault,
577 'relTol' => $numRelPercentTolDefault,
578 'debug' => 0,
579 );
580 num_cmp(\@answerList, %options); 578 num_cmp(\@answerList, %options);
581} 579}
582 580
583sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance 581sub arith_num_cmp_abs { # only allow arithmetic expressions as submitted answer with absolute tolerance
584 my ( $correctAnswer, $absTol, $format ) = @_; 582 my ( $correctAnswer, $absTol, $format ) = @_;
585 583
586 my %options = ( 'tolerance' => $absTol, 584 my %options = ( 'tolerance' => $absTol,
587 'format' => $format 585 'format' => $format
588 ); 586 );
589 587
590 set_default_options (\%options, 588 set_default_options (\%options,
591 'tolType' => 'absolute', 589 'tolType' => 'absolute',
592 'tolerance' => $absTol, 590 'tolerance' => $absTol,
593 'mode' => 'arith', 591 'mode' => 'arith',
594 'format' => $numFormatDefault, 592 'format' => $numFormatDefault,
595 'zeroLevel' => 0, 593 'zeroLevel' => 0,
596 'zeroLevelTol' => 0, 594 'zeroLevelTol' => 0,
597 'debug' => 0, 595 'debug' => 0,
598 ); 596 );
599 num_cmp([$correctAnswer], %options); 597 num_cmp([$correctAnswer], %options);
600
601
602} 598}
603 599
604## See std_num_cmp_list for usage 600## See std_num_cmp_list for usage
605sub arith_num_cmp_abs_list { 601sub arith_num_cmp_abs_list {
606 my ( $absTol, $format, @answerList ) = @_; 602 my ( $absTol, $format, @answerList ) = @_;
607 603
608 my %options = ( 'tolerance' => $absTol, 604 my %options = ( 'tolerance' => $absTol,
609 'format' => $format 605 'format' => $format
610 ); 606 );
611 607
612 set_default_options (\%options, 608 set_default_options (\%options,
613 'tolType' => 'absolute', 609 'tolType' => 'absolute',
614 'tolerance' => $absTol, 610 'tolerance' => $absTol,
615 'mode' => 'arith', 611 'mode' => 'arith',
… …
620 ); 616 );
621 num_cmp(\@answerList, %options); 617 num_cmp(\@answerList, %options);
622 618
623} 619}
624 620
625sub strict_num_cmp { # only allow numbers as submitted answer 621sub strict_num_cmp { # only allow numbers as submitted answer
626
627 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 622 my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
628 623
629 my %options = ( 'tolerance' => $relPercentTol, 624 my %options = ( 'tolerance' => $relPercentTol,
630 'format' => $format, 625 'format' => $format,
631 'zeroLevel' => $zeroLevel, 626 'zeroLevel' => $zeroLevel,
632 'zeroLevelTol' => $zeroLevelTol 627 'zeroLevelTol' => $zeroLevelTol
633 ); 628 );
634 629
635 set_default_options( \%options, 630 set_default_options( \%options,
636 'tolType' => 'relative', 631 'tolType' => 'relative',
637 'tolerance' => $relPercentTol, 632 'tolerance' => $relPercentTol,
… …
640 'zeroLevel' => $numZeroLevelDefault, 635 'zeroLevel' => $numZeroLevelDefault,
641 'zeroLevelTol' => $numZeroLevelTolDefault, 636 'zeroLevelTol' => $numZeroLevelTolDefault,
642 'relTol' => $numRelPercentTolDefault, 637 'relTol' => $numRelPercentTolDefault,
643 'debug' => 0, 638 'debug' => 0,
644 ); 639 );
645
646 num_cmp([$correctAnswer], %options); 640 num_cmp([$correctAnswer], %options);
647
648} 641}
649 642
650## See std_num_cmp_list for usage 643## See std_num_cmp_list for usage
651sub strict_num_cmp_list { # compare numbers 644sub strict_num_cmp_list { # compare numbers
652 my ( $relPercentTol, $format, @answerList ) = @_; 645 my ( $relPercentTol, $format, @answerList ) = @_;
653 646
654 my %options = ( 'tolerance' => $relPercentTol, 647 my %options = ( 'tolerance' => $relPercentTol,
655 'format' => $format, 648 'format' => $format,
656 ); 649 );
657 650
658 set_default_options( \%options, 651 set_default_options( \%options,
659 'tolType' => 'relative', 652 'tolType' => 'relative',
660 'tolerance' => $relPercentTol, 653 'tolerance' => $relPercentTol,
… …
663 'zeroLevel' => $numZeroLevelDefault, 656 'zeroLevel' => $numZeroLevelDefault,
664 'zeroLevelTol' => $numZeroLevelTolDefault, 657 'zeroLevelTol' => $numZeroLevelTolDefault,
665 'relTol' => $numRelPercentTolDefault, 658 'relTol' => $numRelPercentTolDefault,
666 'debug' => 0, 659 'debug' => 0,
667 ); 660 );
668
669 num_cmp(\@answerList, %options); 661 num_cmp(\@answerList, %options);
670 } 662 }
671 663
672 664
673sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance 665sub strict_num_cmp_abs { # only allow numbers as submitted answer with absolute tolerance
674 666
675 my ( $correctAnswer, $absTol, $format ) = @_; 667 my ( $correctAnswer, $absTol, $format ) = @_;
676 668
677 my %options = ( 'tolerance' => $absTol, 669 my %options = ( 'tolerance' => $absTol,
678 'format' => $format 670 'format' => $format
679 ); 671 );
680 672
681 set_default_options (\%options, 673 set_default_options (\%options,
682 'tolType' => 'absolute', 674 'tolType' => 'absolute',
683 'tolerance' => $absTol, 675 'tolerance' => $absTol,
684 'mode' => 'strict', 676 'mode' => 'strict',
685 'format' => $numFormatDefault, 677 'format' => $numFormatDefault,
686 'zeroLevel' => 0, 678 'zeroLevel' => 0,
687 'zeroLevelTol' => 0, 679 'zeroLevelTol' => 0,
688 'debug' => 0, 680 'debug' => 0,
689 ); 681 );
690 682
691 num_cmp([$correctAnswer], %options); 683 num_cmp([$correctAnswer], %options);
692 684
693} 685}
694 686
695## See std_num_cmp_list for usage 687## See std_num_cmp_list for usage
696sub strict_num_cmp_abs_list { # compare numbers 688sub strict_num_cmp_abs_list { # compare numbers
697 my ( $absTol, $format, @answerList ) = @_; 689 my ( $absTol, $format, @answerList ) = @_;
698
699
700 my %options = ( 'tolerance' => $absTol, 690 my %options = ( 'tolerance' => $absTol,
701 'format' => $format 691 'format' => $format
702 ); 692 );
703 693
704 set_default_options (\%options, 694 set_default_options (\%options,
705 'tolType' => 'absolute', 695 'tolType' => 'absolute',
706 'tolerance' => $absTol, 696 'tolerance' => $absTol,
707 'mode' => 'strict', 697 'mode' => 'strict',
… …
711 'debug' => 0, 701 'debug' => 0,
712 ); 702 );
713 703
714 num_cmp(\@answerList, %options); 704 num_cmp(\@answerList, %options);
715 705
716
717
718} 706}
719
720 707
721## Compares a number with units 708## Compares a number with units
722## Deprecated; use num_cmp() 709## Deprecated; use num_cmp()
723## 710##
724## IN: a string which includes the numerical answer and the units 711## IN: a string which includes the numerical answer and the units
… …
728## tol -- an absolute tolerance, or 715## tol -- an absolute tolerance, or
729## relTol -- a relative tolerance 716## relTol -- a relative tolerance
730## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 717## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
731## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 718## zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
732 719
733
734sub check_strings {
735 my ($rh_ans, %options) = @_;
736
737 # if the student's answer is a number, simply return the answer hash (unchanged).
738
739
740 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
741 if ( $rh_ans->{answerIsString} == 1) {
742 #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
743 }
744 return $rh_ans;
745 }
746 # the student's answer is recognized as a string
747 my $ans = $rh_ans->{student_ans};
748
749# OVERVIEW of remindar of function:
750# if answer is correct, return correct. (adjust score to 1)
751# if answer is incorect:
752# 1) determine if the answer is sensible. if it is, return incorrect.
753# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
754# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
755# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
756
757 my $sensibleAnswer = 0;
758 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
759 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
760 my $temp_ans_hash = &$ans_eval($ans);
761 $rh_ans->{test} = $temp_ans_hash;
762 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
763 $rh_ans->{score} = 1;
764 $sensibleAnswer = 1;
765 } else { # students answer does not match the correct answer.
766 ## find out if string makes sense
767 my $legalString = '';
768 my @legalStrings = @{$options{strings}};
769 foreach $legalString (@legalStrings) {
770 if ( uc($ans) eq uc($legalString) ) {
771 $sensibleAnswer = 1;
772 last;
773 }
774 }
775 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
776 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer);
777 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
778 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
779 }
780 $rh_ans->{student_ans} = $ans;
781 if ($sensibleAnswer) {
782 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
783 }
784 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
785
786 $rh_ans;
787
788}
789
790
791
792sub check_units {
793
794 my ($rh_ans, %options) = @_;
795
796 my %correct_units = %{$rh_ans-> {rh_correct_units}};
797
798 my $ans = $rh_ans->{student_ans};
799 # $ans = '' unless defined ($ans);
800 $ans = str_filters ($ans, 'trim_whitespace');
801 my $original_student_ans = $ans;
802
803 $rh_ans->{original_student_ans} = $original_student_ans;
804
805 # it surprises me that the match below works since the first .* is greedy.
806 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
807
808 unless ( defined($num_answer) && $units ) {
809 # there is an error reading the input
810 if ( $ans =~ /\S/ ) { # the answer is not blank
811 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
812 "as a number or an arithmetic expression followed by a unit specification. " .
813 "Your answer must contain units." );
814 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
815 "as a number or an arithmetic expression followed by a unit specification. " .
816 "Your answer must contain units." );
817 }
818
819 return $rh_ans;
820 }
821
822 # we have been able to parse the answer into a numerical part and a unit part
823
824 # $num_answer = $1; #$1 and $2 from the regular expression above
825 # $units = $2;
826
827 my %units = Units::evaluate_units($units);
828 if ( defined( $units{'ERROR'} ) ) {
829 # handle error condition
830 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
831 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
832 $rh_ans -> throw_error('UNITS', "$units{'ERROR'}");
833 return $rh_ans;
834 }
835
836 my $units_match = 1;
837 my $fund_unit;
838 foreach $fund_unit (keys %correct_units) {
839 next if $fund_unit eq 'factor';
840 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
841 }
842
843 if ( $units_match ) {
844 # units are ok. Evaluate the numerical part of the answer
845 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
846 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
847 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
848 $rh_ans->{student_units} = $units;
849 $rh_ans->{student_ans} = $num_answer;
850
851 } else {
852 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
853 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
854 }
855
856 return $rh_ans;
857 }
858
859
860# This mode is depricated. send input through num_cmp -- it can handle units. 720# This mode is depricated. send input through num_cmp -- it can handle units.
721
861sub numerical_compare_with_units { 722sub numerical_compare_with_units {
862 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units. 723 my $correct_answer = shift; # the answer is a string which includes both the numerical answer and the units.
863 my %options = @_; # all of the other inputs are (key value) pairs 724 my %options = @_; # all of the other inputs are (key value) pairs
864 725
865 # Prepare the correct answer 726 # Prepare the correct answer
866 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' ); 727 $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
867 728
868 # it surprises me that the match below works since the first .* is greedy. 729 # it surprises me that the match below works since the first .* is greedy.
869 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/; 730 my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
870
871 $options{units} = $correct_units; 731 $options{units} = $correct_units;
872 732
873 num_cmp($correct_num_answer, %options); 733 num_cmp($correct_num_answer, %options);
874} 734}
875 735
… …
895 $zeroLevel, $zeroLevelTol ) 755 $zeroLevel, $zeroLevelTol )
896 756
897 $correctAnswer -- the correct answer 757 $correctAnswer -- the correct answer
898 $ra_legalStrings -- a reference to an array of legal strings, e.g. ["str1", "str2"] 758 $ra_legalStrings -- a reference to an array of legal strings, e.g. ["str1", "str2"]
899 $relPercentTol -- the error tolerance as a percentage 759 $relPercentTol -- the error tolerance as a percentage
900 $format -- the display format 760 $format -- the display format
901 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 761 $zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
902 $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero 762 $zeroLevelTol -- absolute tolerance to allow when correct answer is close to zero
903 763
904Example: 764Example:
905 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) ); 765 ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
906 766
907=cut 767=cut
908 768
909sub std_num_str_cmp { 769sub std_num_str_cmp {
910 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_; 770 my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
911 # warn ('This method is depreciated. Use num_cmp instead.'); 771 # warn ('This method is depreciated. Use num_cmp instead.');
912 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format, 772 return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
913 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol); 773 zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
914} 774}
… …
926 mode -- 'std' (default) (allows any expression evaluating to a number) 786 mode -- 'std' (default) (allows any expression evaluating to a number)
927 'strict' (only numbers are allowed) 787 'strict' (only numbers are allowed)
928 'frac' (fractions are allowed) 788 'frac' (fractions are allowed)
929 'arith' (arithmetic expressions allowed) 789 'arith' (arithmetic expressions allowed)
930 format -- '%0.5f#' (default); defines formatting for the correct answer 790 format -- '%0.5f#' (default); defines formatting for the correct answer
931 tol -- an absolute tolerance, or 791 tol -- an absolute tolerance, or
932 relTol -- a relative tolerance 792 relTol -- a relative tolerance
933 units -- the units to use for the answer(s) 793 units -- the units to use for the answer(s)
934 strings -- a reference to an array of strings which are valid 794 strings -- a reference to an array of strings which are valid
935 answers (works like std_num_str_cmp() ) 795 answers (works like std_num_str_cmp() )
936 zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies 796 zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
937 zeroLevelTol -- absolute tolerance to allow when answer is close to zero 797 zeroLevelTol -- absolute tolerance to allow when answer is close to zero
938 798
939 Returns an answer evaluator, or (if given a reference to an array of 799 Returns an answer evaluator, or (if given a reference to an array of
940 answers), a list of answer evaluators. Note that a reference to an array of 800 answers), a list of answer evaluators. Note that a reference to an array of
941 answers results is just a shortcut to writing a separate cum_cmp() for each 801 answers results is just a shortcut to writing a separate cum_cmp() for each
942 answer. It does not mean that any of those answers are considered correct 802 answer. It does not mean that any of those answers are considered correct
943 for one question. 803 for one question.
944 804
945EXAMPLES: 805EXAMPLES:
946 806
947 num_cmp( 5 ) -- correct answer is 5, using defaults for all options 807 num_cmp( 5 ) -- correct answer is 5, using defaults for all options
948 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7, using defaults for all options 808 num_cmp( [5,6,7] ) -- correct answers are 5, 6, and 7, using defaults for all options
949 num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict 809 num_cmp( 5, mode => 'strict' ) -- correct answer is 5, mode is strict
950 num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6, both with 5% relative tolerance 810 num_cmp( [5,6], relTol => 5 ) -- correct answers are 5 and 6, both with 5% relative tolerance
951 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] ) -- correct answer is 6, "Inf", "Minf", and "NaN" 811 num_cmp( 6, strings => ["Inf", "Minf", "NaN"] ) -- correct answer is 6, "Inf", "Minf", and "NaN"
952 recognized as valid answers 812 recognized as valid answers
953 813
954=cut 814=cut
955 815
956sub num_cmp { 816sub num_cmp {
957 my $correctAnswer = shift @_; 817 my $correctAnswer = shift @_;
958 my @opt = @_; 818 my @opt = @_;
959 my %out_options; 819 my %out_options;
960 820
961######################################################################### 821#########################################################################
962# Retain this first check for backword compatibility. Allows input of the form 822# Retain this first check for backword compatibility. Allows input of the form
963# num_cmp($ans, 1, '%0.5f') but warns against it 823# num_cmp($ans, 1, '%0.5f') but warns against it
964######################################################################### 824#########################################################################
965
966 my %known_options = ( 'mode' => 'std', 825 my %known_options = ( 'mode' => 'std',
967 'format' => $numFormatDefault, 826 'format' => $numFormatDefault,
968 'tol' => $numAbsTolDefault, 827 'tol' => $numAbsTolDefault,
969 'relTol' => $numRelPercentTolDefault, 828 'relTol' => $numRelPercentTolDefault,
970 'units' => undef, 829 'units' => undef,
… …
975 'tolerance' => 1, 834 'tolerance' => 1,
976 'reltol' => undef, #alternate spelling 835 'reltol' => undef, #alternate spelling
977 'unit' => undef, #alternate spelling 836 'unit' => undef, #alternate spelling
978 'debug' => 0 837 'debug' => 0
979 838
980 ); 839 );
981 840
982 my @output_list; 841 my @output_list;
983 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt; 842 my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
984 843
985 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 || 844 unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
… …
993 " problem using the options style of parameter passing (or" . 852 " problem using the options style of parameter passing (or" .
994 " check that your first option is spelled correctly)."; 853 " check that your first option is spelled correctly).";
995 854
996 855
997 %out_options = ( 'relTol' => $relPercentTol, 856 %out_options = ( 'relTol' => $relPercentTol,
998 'format' => $format, 857 'format' => $format,
999 'zeroLevel' => $zeroLevel, 858 'zeroLevel' => $zeroLevel,
1000 'zeroLevelTol' => $zeroLevelTol, 859 'zeroLevelTol' => $zeroLevelTol,
1001 'mode' => 'std' 860 'mode' => 'std'
1002 ); 861 );
1003 } 862 }
1004# else { 863
1005# # handle options
1006#
1007#
1008# @opt = ( 'relTol' => $relPercentTol,
1009# 'format' => $format,
1010# 'zeroLevel' => $numZeroLevelDefault,
1011# 'zeroLevelTol' => $numZeroLevelTolDefault,
1012# 'mode' => 'std'
1013# );
1014# }
1015######################################################################### 864#########################################################################
1016# Now handle the options assuming they are entered in the form 865# Now handle the options assuming they are entered in the form
1017# num_cmp($ans, relTol=>1, format=>'%0.5f') 866# num_cmp($ans, relTol=>1, format=>'%0.5f')
1018######################################################################### 867#########################################################################
1019 %out_options = @opt; 868 %out_options = @opt;
1020 assign_option_aliases( \%out_options, 869 assign_option_aliases( \%out_options,
1021 'reltol' => 'relTol', 870 'reltol' => 'relTol',
1022 'unit' => 'units', 871 'unit' => 'units',
1023 ); 872 );
1024
1025
1026
1027 873
1028 set_default_options( \%out_options, 874 set_default_options( \%out_options,
1029 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative', 875 'tolType' => (defined($out_options{tol}) ) ? 'absolute' : 'relative',
1030 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault, 876 'tolerance' => (defined($out_options{tol}) ) ? $numAbsTolDefault : $numRelPercentTolDefault,
1031 'mode' => 'std', 877 'mode' => 'std',
… …
1035 'units' => undef, 881 'units' => undef,
1036 'strings' => undef, 882 'strings' => undef,
1037 'zeroLevel' => $numZeroLevelDefault, 883 'zeroLevel' => $numZeroLevelDefault,
1038 'zeroLevelTol' => $numZeroLevelTolDefault, 884 'zeroLevelTol' => $numZeroLevelTolDefault,
1039 'debug' => 0, 885 'debug' => 0,
1040 886 );
1041 );
1042
1043
1044
1045
1046
1047 887
1048 # can't use both units and strings 888 # can't use both units and strings
1049 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) { 889 if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
1050 warn "Can't use both 'units' and 'strings' in the same problem " . 890 warn "Can't use both 'units' and 'strings' in the same problem " .
1051 "(check your parameters to num_cmp() )"; 891 "(check your parameters to num_cmp() )";
1052
1053 } 892 }
1054
1055 893
1056 # my ($tolType, $tol); 894 # my ($tolType, $tol);
1057 if ($out_options{tolType} eq 'absolute') { 895 if ($out_options{tolType} eq 'absolute') {
1058 $out_options{'tolerance'}=$out_options{'tol'}; 896 $out_options{'tolerance'}=$out_options{'tol'};
1059 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} ); 897 delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
… …
1066 my @ans_list = (); 904 my @ans_list = ();
1067 905
1068 if ( ref($correctAnswer) eq 'ARRAY' ) { 906 if ( ref($correctAnswer) eq 'ARRAY' ) {
1069 @ans_list = @{$correctAnswer}; 907 @ans_list = @{$correctAnswer};
1070 } 908 }
1071 else {
1072 push( @ans_list, $correctAnswer ); 909 else { push( @ans_list, $correctAnswer );
1073 } 910 }
1074 911
1075 # produce answer evaluators 912 # produce answer evaluators
1076 foreach my $ans (@ans_list) { 913 foreach my $ans (@ans_list) {
1077 if( defined( $out_options{'units'} ) ) { 914 if( defined( $out_options{'units'} ) ) {
… …
1084 'mode' => $out_options{'mode'}, 921 'mode' => $out_options{'mode'},
1085 'zeroLevel' => $out_options{'zeroLevel'}, 922 'zeroLevel' => $out_options{'zeroLevel'},
1086 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 923 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1087 'debug' => $out_options{'debug'}, 924 'debug' => $out_options{'debug'},
1088 'units' => $out_options{'units'}, 925 'units' => $out_options{'units'},
1089 ) 926 )
1090 ); 927 );
1091 } 928 }
1092 elsif( defined( $out_options{'strings'} ) ) { 929 elsif( defined( $out_options{'strings'} ) ) {
1093 #if( defined $out_options{'tol'} ) { 930 #if( defined $out_options{'tol'} ) {
1094 # warn "You are using 'tol' (for absolute tolerance) with a num/str " . 931 # warn "You are using 'tol' (for absolute tolerance) with a num/str " .
… …
1103 'mode' => $out_options{'mode'}, 940 'mode' => $out_options{'mode'},
1104 'zeroLevel' => $out_options{'zeroLevel'}, 941 'zeroLevel' => $out_options{'zeroLevel'},
1105 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 942 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1106 'debug' => $out_options{'debug'}, 943 'debug' => $out_options{'debug'},
1107 'strings' => $out_options{'strings'}, 944 'strings' => $out_options{'strings'},
1108 945 )
1109 )
1110 ); 946 );
1111 }
1112 else { 947 } else {
1113
1114 push(@output_list, 948 push(@output_list,
1115 NUM_CMP( 'correctAnswer' => $ans, 949 NUM_CMP( 'correctAnswer' => $ans,
1116 'tolerance' => $out_options{tolerance}, 950 'tolerance' => $out_options{tolerance},
1117 'tolType' => $out_options{tolType}, 951 'tolType' => $out_options{tolType},
1118 'format' => $out_options{'format'}, 952 'format' => $out_options{'format'},
1119 'mode' => $out_options{'mode'}, 953 'mode' => $out_options{'mode'},
1120 'zeroLevel' => $out_options{'zeroLevel'}, 954 'zeroLevel' => $out_options{'zeroLevel'},
1121 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 955 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1122 'debug' => $out_options{'debug'}, 956 'debug' => $out_options{'debug'},
1123
1124 ), 957 ),
1125 ); 958 );
1126 } 959 }
1127 } 960 }
1128 961
1129 return @output_list; 962 return @output_list;
1130 } 963 }
1131 964
1132#legacy code for compatability purposes 965#legacy code for compatability purposes
1133sub num_rel_cmp { # compare numbers 966sub num_rel_cmp { # compare numbers
1134 std_num_cmp( @_ ); 967 std_num_cmp( @_ );
1135} 968}
1136 969
1137## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
1138##
1139## IN: a hash containing the following items (error-checking to be added later?):
1140## correctAnswer -- the correct answer
1141## tolerance -- the allowable margin of error
1142## tolType -- 'relative' or 'absolute'
1143## format -- the display format of the answer
1144## mode -- one of 'std', 'strict', 'arith', or 'frac';
1145## determines allowable formats for the input
1146## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
1147## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1148
1149sub compare_numbers {
1150 my ($rh_ans, %options) = @_;
1151 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1152 if ($PG_eval_errors) {
1153 $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
1154 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
1155
1156
1157 } else {
1158 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
1159 }
1160
1161 my $permitted_error;
1162
1163 if ($rh_ans->{tolType} eq 'absolute') {
1164 $permitted_error = $rh_ans->{tolerance};
1165
1166 }
1167 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
1168 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
1169 }
1170 else {
1171 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
1172 }
1173
1174 my $is_a_number = is_a_number($inVal);
1175 $rh_ans->{score} = 1 if ( ($is_a_number) and
1176 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
1177 if (not $is_a_number) {
1178 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number');
1179 }
1180
1181 $rh_ans;
1182}
1183
1184sub NUM_CMP { # low level numeric compare 970sub NUM_CMP { # low level numeric compare
1185 my %num_params = @_; 971 my %num_params = @_;
1186 972
1187 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug ); 973 my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
1188 foreach my $key (@keys) { 974 foreach my $key (@keys) {
1189 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key}); 975 warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
… …
1237 if ( uc($correctAnswer) eq uc($legalString) ) { 1023 if ( uc($correctAnswer) eq uc($legalString) ) {
1238 $corrAnswerIsString = 1; 1024 $corrAnswerIsString = 1;
1239 last; 1025 last;
1240 } 1026 }
1241 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric 1027 } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
1242
1243 1028
1244 } else { 1029 } else {
1245 $correct_num_answer = $correctAnswer; 1030 $correct_num_answer = $correctAnswer;
1246 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} ); 1031 $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
1247 } 1032 }
… …
1253 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report); 1038 my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
1254 1039
1255 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) { 1040 if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
1256 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer); 1041 ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
1257 } 1042 }
1258 else {
1259 $PG_eval_errors = ' '; 1043 else { $PG_eval_errors = ' ';
1260 } 1044 }
1261 1045
1262 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) { 1046 if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
1263 ##error message from eval or above 1047 ##error message from eval or above
1264 warn "Error in 'correct' answer: $PG_eval_errors<br> 1048 warn "Error in 'correct' answer: $PG_eval_errors<br>
… …
1333 1117
1334 1118
1335 $answer_evaluator; 1119 $answer_evaluator;
1336} 1120}
1337 1121
1338sub fix_answers_for_display { 1122sub fix_answers_for_display {
1339 my ($rh_ans, %options) = @_; 1123 my ($rh_ans, %options) = @_;
1340 if ( $rh_ans->{answerIsString} ==1) { 1124 if ( $rh_ans->{answerIsString} ==1) {
1341 $rh_ans = evaluatesToNumber ($rh_ans, %options); 1125 $rh_ans = evaluatesToNumber ($rh_ans, %options);
1342 } 1126 }
1343 if (defined ($rh_ans->{student_units})) { 1127 if (defined ($rh_ans->{student_units})) {
… …
1345 } 1129 }
1346 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans}; 1130 $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
1347 $rh_ans; 1131 $rh_ans;
1348} 1132}
1349 1133
1350sub evaluatesToNumber { 1134sub evaluatesToNumber {
1351 my ($rh_ans, %options) = @_; 1135 my ($rh_ans, %options) = @_;
1352 if (is_a_numeric_expression($rh_ans->{student_ans})) { 1136 if (is_a_numeric_expression($rh_ans->{student_ans})) {
1353 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans}); 1137 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
1354 if ($PG_eval_errors) { # this if statement should never be run 1138 if ($PG_eval_errors) { # this if statement should never be run
1355 # change nothing 1139 # change nothing
… …
1359 } 1143 }
1360 } 1144 }
1361 $rh_ans; 1145 $rh_ans;
1362} 1146}
1363 1147
1364sub is_a_numeric_expression { 1148sub is_a_numeric_expression {
1365 my $testString = shift; 1149 my $testString = shift;
1366 my $is_a_numeric_expression = 0; 1150 my $is_a_numeric_expression = 0;
1367 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString); 1151 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString);
1368 if ($PG_eval_errors) { 1152 if ($PG_eval_errors) {
1369 $is_a_numeric_expression = 0; 1153 $is_a_numeric_expression = 0;
… …
1593 'debug' => $options{debug} , 1377 'debug' => $options{debug} ,
1594 ); 1378 );
1595 1379
1596} 1380}
1597 1381
1598sub function_cmp { 1382sub function_cmp {
1599 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_; 1383 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
1600 1384
1601 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) { 1385 if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
1602 function_invalid_params( $correctEqn ); 1386 function_invalid_params( $correctEqn );
1603 } 1387 }
… …
1614 'zeroLevelTol' => $zeroLevelTol 1398 'zeroLevelTol' => $zeroLevelTol
1615 ); 1399 );
1616 } 1400 }
1617} 1401}
1618 1402
1619sub function_cmp_up_to_constant { ## for antiderivative problems 1403sub function_cmp_up_to_constant { ## for antiderivative problems
1620 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_; 1404 my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_;
1621 1405
1622 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) { 1406 if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
1623 function_invalid_params( $correctEqn ); 1407 function_invalid_params( $correctEqn );
1624 } 1408 }
… …
1635 'zeroLevelTol' => $zeroLevelTol 1419 'zeroLevelTol' => $zeroLevelTol
1636 ); 1420 );
1637 } 1421 }
1638} 1422}
1639 1423
1640sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance 1424sub function_cmp_abs { ## similar to function_cmp but uses absolute tolerance
1641 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_; 1425 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_;
1642 1426
1643 if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) { 1427 if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) {
1644 function_invalid_params( $correctEqn ); 1428 function_invalid_params( $correctEqn );
1645 } 1429 }
1646 else { 1430 else {
1647 FUNCTION_CMP( 'correctEqn' => $correctEqn, 1431 FUNCTION_CMP( 'correctEqn' => $correctEqn,
1648 'var' => $var, 1432 'var' => $var,
1649 'limits' => [$llimit, $ulimit], 1433 'limits' => [$llimit, $ulimit],
1650 'tolerance' => $absTol, 1434 'tolerance' => $absTol,
1651 'tolType' => 'absolute', 1435 'tolType' => 'absolute',
1652 'numPoints' => $numPoints, 1436 'numPoints' => $numPoints,
1653 'mode' => 'std', 1437 'mode' => 'std',
1654 'maxConstantOfIntegration' => 0, 1438 'maxConstantOfIntegration' => 0,
1655 'zeroLevel' => 0, 1439 'zeroLevel' => 0,
1656 'zeroLevelTol' => 0 1440 'zeroLevelTol' => 0
1657 ); 1441 );
1658 } 1442 }
1659} 1443}
1660 1444
1661 1445
1662sub function_cmp_up_to_constant_abs { ## for antiderivative problems 1446sub function_cmp_up_to_constant_abs { ## for antiderivative problems
1663 ## similar to function_cmp_up_to_constant 1447 ## similar to function_cmp_up_to_constant
1664 ## but uses absolute tolerance 1448 ## but uses absolute tolerance
1665 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_; 1449 my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_;
1666 1450
1667 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) { 1451 if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
… …
1908## zeroLevel -- if the correct answer is this close to zero, 1692## zeroLevel -- if the correct answer is this close to zero,
1909## then zeroLevelTol applies 1693## then zeroLevelTol applies
1910## zeroLevelTol -- absolute tolerance to allow when answer is close to zero 1694## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
1911 1695
1912 1696
1913sub FUNCTION_CMP { 1697sub FUNCTION_CMP {
1914 my %func_params = @_; 1698 my %func_params = @_;
1915 1699
1916 my $correctEqn = $func_params{'correctEqn'}; 1700 my $correctEqn = $func_params{'correctEqn'};
1917 my $var = $func_params{'var'}; 1701 my $var = $func_params{'var'};
1918 my $ra_limits = $func_params{'limits'}; 1702 my $ra_limits = $func_params{'limits'};
… …
2015 1799
2016#construct the answer evaluator 1800#construct the answer evaluator
2017 my $answer_evaluator = new AnswerEvaluator; 1801 my $answer_evaluator = new AnswerEvaluator;
2018 $answer_evaluator->{debug} = $func_params{debug}; 1802 $answer_evaluator->{debug} = $func_params{debug};
2019 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn, 1803 $answer_evaluator->ans_hash( correct_ans => $originalCorrEqn,
2020 rf_correct_ans => $rh_correct_ans->{rf_correct_ans}, 1804 rf_correct_ans => $rh_correct_ans->{rf_correct_ans},
2021 evaluation_points => \@evaluation_points, 1805 evaluation_points => \@evaluation_points,
2022 ra_param_vars => \@PARAMS, 1806 ra_param_vars => \@PARAMS,
2023 ra_vars => \@VARS, 1807 ra_vars => \@VARS,
2024 type => 'function', 1808 type => 'function',
2025 ); 1809 );
2026 1810
2027 $answer_evaluator->install_pre_filter(\&check_syntax); 1811 $answer_evaluator->install_pre_filter(\&check_syntax);
2028 $answer_evaluator->install_pre_filter(\&function_from_string2, ra_vars => \@VARS,debug=>$func_params{debug},); # @VARS has been guaranteed to be an array, $var might be a single string. 1812 $answer_evaluator->install_pre_filter(\&function_from_string2, ra_vars => \@VARS,debug=>$func_params{debug},); # @VARS has been guaranteed to be an array, $var might be a single string.
2029 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS); 1813 $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS);
2030 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params); 1814 $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params);
2031 $answer_evaluator->install_evaluator(\&is_zero_array, tol => $tol ); 1815 $answer_evaluator->install_evaluator(\&is_zero_array, tol => $tol );
2032 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); $rh_ans;} ); 1816 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); $rh_ans;} );
2033 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; 1817 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
2034 if ($rh_ans->catch_error('EVAL') ) { 1818 if ($rh_ans->catch_error('EVAL') ) {
2035 $rh_ans->{ans_message} = $rh_ans->{error_message}; 1819 $rh_ans->{ans_message} = $rh_ans->{error_message};
2036 $rh_ans->clear_error('EVAL'); 1820 $rh_ans->clear_error('EVAL');
2037 } 1821 }
2038 $rh_ans; 1822 $rh_ans;
2039 }); 1823 });
2040 $answer_evaluator; 1824 $answer_evaluator;
2041} 1825}
2042 1826
2043=head4 Filters 1827=head4 Filters
… …
2047 is_array($rh_ans) 1831 is_array($rh_ans)
2048 returns: $rh_ans. Throws error "NOTARRAY" if this is not an array 1832 returns: $rh_ans. Throws error "NOTARRAY" if this is not an array
2049 1833
2050=cut 1834=cut
2051 1835
2052sub is_array{ 1836sub is_array {
2053 my $rh_ans = shift; 1837 my $rh_ans = shift;
2054 # return if the result is an array 1838 # return if the result is an array
2055 return($rh_ans) if ref($rh_ans->{student_ans}) eq 'ARRAY' ; 1839 return($rh_ans) if ref($rh_ans->{student_ans}) eq 'ARRAY' ;
2056 $rh_ans->throw_error("NOTARRAY","The answer is not an array"); 1840 $rh_ans->throw_error("NOTARRAY","The answer is not an array");
2057 $rh_ans; 1841 $rh_ans;
… …
2105 1889
2106} 1890}
2107 1891
2108=pod 1892=pod
2109 1893
1894 check_strings ($rh_ans, %options)
1895 returns $rh_ans
1896
1897
1898=cut
1899
1900sub check_strings {
1901 my ($rh_ans, %options) = @_;
1902
1903 # if the student's answer is a number, simply return the answer hash (unchanged).
1904
1905
1906 if ( $rh_ans->{student_ans} =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/) {
1907 if ( $rh_ans->{answerIsString} == 1) {
1908 #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
1909 }
1910 return $rh_ans;
1911 }
1912 # the student's answer is recognized as a string
1913 my $ans = $rh_ans->{student_ans};
1914# OVERVIEW of remindar of function:
1915# if answer is correct, return correct. (adjust score to 1)
1916# if answer is incorect:
1917# 1) determine if the answer is sensible. if it is, return incorrect.
1918# 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
1919# no matter what: throw a 'STRING' error to skip numerical evaluations. (error flag skips remainder of pre_filters and evaluators)
1920# last: 'STRING' post_filter will clear the error (avoiding pink screen.)
1921 my $sensibleAnswer = 0;
1922 $ans = str_filters( $ans, 'compress_whitespace' ); # remove trailing, leading, and double spaces.
1923 my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
1924 my $temp_ans_hash = &$ans_eval($ans);
1925 $rh_ans->{test} = $temp_ans_hash;
1926 if ($temp_ans_hash->{score} ==1 ) { # students answer matches the correct answer.
1927 $rh_ans->{score} = 1;
1928 $sensibleAnswer = 1;
1929 } else { # students answer does not match the correct answer.
1930 my $legalString = ''; ## find out if string makes sense
1931 my @legalStrings = @{$options{strings}};
1932 foreach $legalString (@legalStrings) {
1933 if ( uc($ans) eq uc($legalString) ) {
1934 $sensibleAnswer = 1;
1935 last;
1936 }
1937 }
1938 $sensibleAnswer = 1 unless $ans =~ /\S/; ## empty answers are sensible
1939 $rh_ans->throw_error('EVAL', "$BR Your answer is not a recognized answer") unless ($sensibleAnswer);
1940 # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
1941 # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
1942 }
1943 $rh_ans->{student_ans} = $ans;
1944 if ($sensibleAnswer) {
1945 $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
1946 }
1947 # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
1948 $rh_ans;
1949}
1950
1951=pod
1952
1953 check_strings ($rh_ans, %options)
1954 returns $rh_ans
1955
1956
1957=cut
1958
1959sub check_units {
1960 my ($rh_ans, %options) = @_;
1961 my %correct_units = %{$rh_ans-> {rh_correct_units}};
1962 my $ans = $rh_ans->{student_ans};
1963 # $ans = '' unless defined ($ans);
1964 $ans = str_filters ($ans, 'trim_whitespace');
1965 my $original_student_ans = $ans;
1966 $rh_ans->{original_student_ans} = $original_student_ans;
1967
1968 # it surprises me that the match below works since the first .* is greedy.
1969 my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
1970
1971 unless ( defined($num_answer) && $units ) {
1972 # there is an error reading the input
1973 if ( $ans =~ /\S/ ) { # the answer is not blank
1974 $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
1975 "as a number or an arithmetic expression followed by a unit specification. " .
1976 "Your answer must contain units." );
1977 $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
1978 "as a number or an arithmetic expression followed by a unit specification. " .
1979 "Your answer must contain units." );
1980 }
1981 return $rh_ans;
1982 }
1983
1984 # we have been able to parse the answer into a numerical part and a unit part
1985
1986 # $num_answer = $1; #$1 and $2 from the regular expression above
1987 # $units = $2;
1988
1989 my %units = Units::evaluate_units($units);
1990 if ( defined( $units{'ERROR'} ) ) {
1991 # handle error condition
1992 $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
1993 $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
1994 $rh_ans -> throw_error('UNITS', "$units{'ERROR'}");
1995 return $rh_ans;
1996 }
1997
1998 my $units_match = 1;
1999 my $fund_unit;
2000 foreach $fund_unit (keys %correct_units) {
2001 next if $fund_unit eq 'factor';
2002 $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
2003 }
2004
2005 if ( $units_match ) {
2006 # units are ok. Evaluate the numerical part of the answer
2007 $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'} if
2008 $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
2009 $rh_ans->{correct_ans} = prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
2010 $rh_ans->{student_units} = $units;
2011 $rh_ans->{student_ans} = $num_answer;
2012
2013 } else {
2014 $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
2015 $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
2016 }
2017
2018 return $rh_ans;
2019}
2020
2021## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
2022##
2023## IN: a hash containing the following items (error-checking to be added later?):
2024## correctAnswer -- the correct answer
2025## tolerance -- the allowable margin of error
2026## tolType -- 'relative' or 'absolute'
2027## format -- the display format of the answer
2028## mode -- one of 'std', 'strict', 'arith', or 'frac';
2029## determines allowable formats for the input
2030## zeroLevel -- if the correct answer is this close to zero, then zeroLevelTol applies
2031## zeroLevelTol -- absolute tolerance to allow when answer is close to zero
2032
2033sub compare_numbers {
2034 my ($rh_ans, %options) = @_;
2035 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
2036 if ($PG_eval_errors) {
2037 $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
2038 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
2039
2040 } else {
2041 $rh_ans->{student_ans} = prfmt($inVal,$options{format});
2042 }
2043
2044 my $permitted_error;
2045
2046 if ($rh_ans->{tolType} eq 'absolute') {
2047 $permitted_error = $rh_ans->{tolerance};
2048 }
2049 elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
2050 $permitted_error = $options{zeroLevelTol}; ## want $tol to be non zero
2051 }
2052 else {
2053 $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
2054 }
2055
2056 my $is_a_number = is_a_number($inVal);
2057 $rh_ans->{score} = 1 if ( ($is_a_number) and
2058 (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
2059 if (not $is_a_number) {
2060 $rh_ans->throw_error('EVAL','Your answer does not evaluate to a number');
2061 }
2062
2063 $rh_ans;
2064}
2065
2066
2067
2068=pod
2069
2110 std_num_filter($rh_ans, %options) 2070 std_num_filter($rh_ans, %options)
2111 returns $rh_ans 2071 returns $rh_ans
2112 2072
2113Replaces some constants using math_constants, then evaluates a perl expression. 2073Replaces some constants using math_constants, then evaluates a perl expression.
2114 2074
… …
2122 $in = math_constants($in); 2082 $in = math_constants($in);
2123 $rh_ans->{type} = 'std_number'; 2083 $rh_ans->{type} = 'std_number';
2124 my ($inVal,$PG_eval_errors,$PG_full_error_report); 2084 my ($inVal,$PG_eval_errors,$PG_full_error_report);
2125 if ($in =~ /\S/) { 2085 if ($in =~ /\S/) {
2126 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in); 2086 ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
2127 } else { 2087 } else {
2128 $PG_eval_errors = ''; 2088 $PG_eval_errors = '';
2129 } 2089 }
2130 2090
2131 if ($PG_eval_errors) { ##error message from eval or above 2091 if ($PG_eval_errors) { ##error message from eval or above
2132 $rh_ans->{ans_message} = 'There is a syntax error in your answer'; 2092 $rh_ans->{ans_message} = 'There is a syntax error in your answer';
… …
2146to each element of the array. Does it's best to generate sensible error messages for syntax errors. 2106to each element of the array. Does it's best to generate sensible error messages for syntax errors.
2147A typical error message displayed in {studnet_ans} might be ( 56, error message, -4). 2107A typical error message displayed in {studnet_ans} might be ( 56, error message, -4).
2148 2108
2149=cut 2109=cut
2150 2110
2151sub std_num_array_filter{ 2111sub std_num_array_filter {
2152 my $rh_ans= shift; 2112 my $rh_ans= shift;
2153 my %options = @_; 2113 my %options = @_;
2154 my @in = @{$rh_ans->{student_ans}}; 2114 my @in = @{$rh_ans->{student_ans}};
2155 my $temp_hash = new AnswerHash; 2115 my $temp_hash = new AnswerHash;
2156 my @out=(); 2116 my @out=();
… …
2179 $rh_ans->input( [@out] ); 2139 $rh_ans->input( [@out] );
2180 } 2140 }
2181 $rh_ans; 2141 $rh_ans;
2182} 2142}
2183 2143
2184
2185
2186sub function_from_string2 { 2144sub function_from_string2 {
2187 my $rh_ans = shift; 2145 my $rh_ans = shift;
2188 my %options = @_; 2146 my %options = @_;
2189 my $eqn = $rh_ans->{student_ans}; 2147 my $eqn = $rh_ans->{student_ans};
2190 set_default_options( \%options, 2148 set_default_options( \%options,
2191 'store_in' => 'rf_student_ans', 2149 'store_in' => 'rf_student_ans',
2192 'ra_vars' => [qw( x y )], 2150 'ra_vars' => [qw( x y )],
2193 'debug' => 0, 2151 'debug' => 0,
2194 ); 2152 );
2195 my @VARS = @{ $options{ 'ra_vars'}}; 2153 my @VARS = @{ $options{ 'ra_vars'}};
2196 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 2154 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
2197 my $originalEqn = $eqn; 2155 my $originalEqn = $eqn;
2198 $eqn = &math_constants($eqn); 2156 $eqn = &math_constants($eqn);
2199 for( my $i = 0; $i < @VARS; $i++ ) { 2157 for( my $i = 0; $i < @VARS; $i++ ) {
2200 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1 2158 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
2201 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"'); 2159 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
2202# $eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 2160 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
2203 $eqn =~ s/\b$temp\b/\$VARS[$i]/g; 2161 $eqn =~ s/\b$temp\b/\$VARS[$i]/g;
2204 2162
2205 } 2163 }
2206 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 2164 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
2207 pretty_print(\%options) 2165 pretty_print(\%options)
… …
2249# $rh_ans ->{$options{store_in}} = $function_sub; 2207# $rh_ans ->{$options{store_in}} = $function_sub;
2250# } else { 2208# } else {
2251# $rh_ans->{rf_student_ans} = $function_sub; 2209# $rh_ans->{rf_student_ans} = $function_sub;
2252# } 2210# }
2253 $rh_ans ->{$options{store_in}} = $function_sub; 2211 $rh_ans ->{$options{store_in}} = $function_sub;
2254
2255 } 2212 }
2256 2213
2257 $rh_ans; 2214 $rh_ans;
2258} 2215}
2259 2216
2260 2217
2261sub is_zero_array{ 2218sub is_zero_array {
2262 my $rh_ans = shift; 2219 my $rh_ans = shift;
2263 my %options = @_; 2220 my %options = @_;
2264 my $array = $rh_ans -> {ra_differences}; 2221 my $array = $rh_ans -> {ra_differences};
2265 my $num = @$array; 2222 my $num = @$array;
2266 my $i; 2223 my $i;
… …
2285 2242
2286 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0; 2243 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0;
2287 } 2244 }
2288 $rh_ans; 2245 $rh_ans;
2289} 2246}
2247
2290=pod 2248=pod
2291 2249
2292 best_approx_parameters($rh_ans,%options); 2250 best_approx_parameters($rh_ans,%options);
2293 {rf_student_ans} # reference to the test answer 2251 {rf_student_ans} # reference to the test answer
2294 {rf_correct_ans} # reference to the comparison answer 2252 {rf_correct_ans} # reference to the comparison answer
2295 {evaluation_points}, # an array of row vectors indicating the points 2253 {evaluation_points}, # an array of row vectors indicating the points
2296 # to evaluate when comparing the functions 2254 # to evaluate when comparing the functions
2297 %options # debug => 1 gives more error answers 2255 %options # debug => 1 gives more error answers
2298 # param_vars => [''] additional parameters used to adapt to function 2256 # param_vars => [''] additional parameters used to adapt to function
2299 ) 2257 )
2300 returns $rh_ans; 2258 returns $rh_ans;
2301 The parameters for the comparison function which best approximates the test_function are stored 2259 The parameters for the comparison function which best approximates the test_function are stored
2302 in the field {ra_parameters}. 2260 in the field {ra_parameters}.
2303 2261
… …
2310 2268
2311The comparison function should have $dim_of_params_space more input variables than the test function. 2269The comparison function should have $dim_of_params_space more input variables than the test function.
2312 2270
2313=cut 2271=cut
2314 2272
2315
2316
2317
2318
2319# =pod 2273=pod
2320# 2274
2321# Used internally: 2275 Used internally:
2322# 2276
2323# &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function 2277 &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function
2324# $ra_variables # an array of the active input variables to the functions 2278 $ra_variables # an array of the active input variables to the functions
2325# $dim_of_params_space # indicates the number of parameters upon which the 2279 $dim_of_params_space # indicates the number of parameters upon which the
2326# # the comparison function depends linearly. These are assumed to 2280 # the comparison function depends linearly. These are assumed to
2327# # be the last group of inputs to the comparison function. 2281 # be the last group of inputs to the comparison function.
2328# 2282
2329# %options # $options{debug} gives more error messages 2283 %options # $options{debug} gives more error messages
2330# 2284
2331# # A typical function might look like 2285 # A typical function might look like
2332# # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter 2286 # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter
2333# # space of dimension 2 and a variable space of dimension 3. 2287 # space of dimension 2 and a variable space of dimension 3.
2334# ) 2288 )
2335# # returns a list of coefficients 2289 # returns a list of coefficients
2336# 2290
2337# =cut 2291=cut
2338 2292
2339
2340sub best_approx_parameters{ 2293sub best_approx_parameters {
2341 my $rh_ans = shift; 2294 my $rh_ans = shift;
2342 my %options = @_; 2295 my %options = @_;
2343 my $errors = undef; 2296 my $errors = undef;
2344 # This subroutine for the determining the coefficents of the parameters at a given point 2297 # This subroutine for the determining the coefficents of the parameters at a given point
2345 # is pretty specialized, so it is included here as a sub-subroutine. 2298 # is pretty specialized, so it is included here as a sub-subroutine.
… …
2414 while(@coeff) { 2367 while(@coeff) {
2415 $matrix->assign($row_num,$col_num, shift(@coeff) ); 2368 $matrix->assign($row_num,$col_num, shift(@coeff) );
2416 $col_num++; 2369 $col_num++;
2417 } 2370 }
2418 } 2371 }
2419
2420 } 2372 }
2421 $row_num++; 2373 $row_num++;
2422 last if $errors; # break if there are any errors. 2374 last if $errors; # break if there are any errors.
2423 # This cuts down on the size of error messages. 2375 # This cuts down on the size of error messages.
2424 # However it impossible to check for equivalence at 95% of points 2376 # However it impossible to check for equivalence at 95% of points
… …
2517 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number? 2469 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number?
2518 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2470 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
2519 2471
2520 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2472 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
2521 #warn "diff = $diff"; 2473 #warn "diff = $diff";
2522
2523 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel}; 2474 $diff = ( $inVal - ($correctVal-$tol_val ) )/abs($tol_val) -1 if abs($tol_val) > $options{zeroLevel};
2524 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel}; 2475 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel};
2525 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal"; 2476 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
2526 } 2477 }
2527 } 2478 }
… …
2641 $filteredAnswer =~ s/\s+//g; # remove all whitespace 2592 $filteredAnswer =~ s/\s+//g; # remove all whitespace
2642 2593
2643 return $filteredAnswer; 2594 return $filteredAnswer;
2644} 2595}
2645 2596
2646sub compress_whitespace { 2597sub compress_whitespace {
2647 my $filteredAnswer = shift; 2598 my $filteredAnswer = shift;
2648 2599
2649 $filteredAnswer =~ s/^\s*//; # remove initial whitespace 2600 $filteredAnswer =~ s/^\s*//; # remove initial whitespace
2650 $filteredAnswer =~ s/\s*$//; # remove trailing whitespace 2601 $filteredAnswer =~ s/\s*$//; # remove trailing whitespace
2651 $filteredAnswer =~ s/\s+/ /g; # replace spaces by single space 2602 $filteredAnswer =~ s/\s+/ /g; # replace spaces by single space
… …
2731 ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and 2682 ANS( ordered_cs_str_cmp( "ABC" ) ) -- Rejects "abc", accepts "A BC" and
2732 so forth. Same as ordered_str_cmp() but case sensitive. 2683 so forth. Same as ordered_str_cmp() but case sensitive.
2733 2684
2734=cut 2685=cut
2735 2686
2736sub std_str_cmp { # compare strings 2687sub std_str_cmp { # compare strings
2737 my $correctAnswer = shift @_; 2688 my $correctAnswer = shift @_;
2738 my @filters = ( 'compress_whitespace', 'ignore_case' ); 2689 my @filters = ( 'compress_whitespace', 'ignore_case' );
2739 my $type = 'std_str_cmp'; 2690 my $type = 'std_str_cmp';
2740 STR_CMP( 'correctAnswer' => $correctAnswer, 2691 STR_CMP( 'correctAnswer' => $correctAnswer,
2741 'filters' => \@filters, 2692 'filters' => \@filters,
2742 'type' => $type 2693 'type' => $type
2743 ); 2694 );
2744} 2695}
2745 2696
2746sub std_str_cmp_list { # alias for std_str_cmp 2697sub std_str_cmp_list { # alias for std_str_cmp
2747 my @answerList = @_; 2698 my @answerList = @_;
2748 my @output; 2699 my @output;
2749 while (@answerList) { 2700 while (@answerList) {
2750 push( @output, std_str_cmp(shift @answerList) ); 2701 push( @output, std_str_cmp(shift @answerList) );
2751 } 2702 }
2752 @output; 2703 @output;
2753} 2704}
2754 2705
2755sub std_cs_str_cmp { # compare strings case sensitive 2706sub std_cs_str_cmp { # compare strings case sensitive
2756 my $correctAnswer = shift @_; 2707 my $correctAnswer = shift @_;
2757 my @filters = ( 'compress_whitespace' ); 2708 my @filters = ( 'compress_whitespace' );
2758 my $type = 'std_cs_str_cmp'; 2709 my $type = 'std_cs_str_cmp';
2759 STR_CMP( 'correctAnswer' => $correctAnswer, 2710 STR_CMP( 'correctAnswer' => $correctAnswer,
2760 'filters' => \@filters, 2711 'filters' => \@filters,
2761 'type' => $type 2712 'type' => $type
2762 ); 2713 );
2763} 2714}
2764 2715
2765sub std_cs_str_cmp_list { # alias for std_cs_str_cmp 2716sub std_cs_str_cmp_list { # alias for std_cs_str_cmp
2766 my @answerList = @_; 2717 my @answerList = @_;
2767 my @output; 2718 my @output;
2768 while (@answerList) { 2719 while (@answerList) {
2769 push( @output, std_cs_str_cmp(shift @answerList) ); 2720 push( @output, std_cs_str_cmp(shift @answerList) );
2770 } 2721 }
2771 @output; 2722 @output;
2772} 2723}
2773 2724
2774sub strict_str_cmp { # strict string compare 2725sub strict_str_cmp { # strict string compare
2775 my $correctAnswer = shift @_; 2726 my $correctAnswer = shift @_;
2776 my @filters = ( 'trim_whitespace' ); 2727 my @filters = ( 'trim_whitespace' );
2777 my $type = 'strict_str_cmp'; 2728 my $type = 'strict_str_cmp';
2778 STR_CMP( 'correctAnswer' => $correctAnswer, 2729 STR_CMP( 'correctAnswer' => $correctAnswer,
2779 'filters' => \@filters, 2730 'filters' => \@filters,
2780 'type' => $type 2731 'type' => $type
2781 ); 2732 );
2782} 2733}
2783 2734
2784sub strict_str_cmp_list { # alias for strict_str_cmp 2735sub strict_str_cmp_list { # alias for strict_str_cmp
2785 my @answerList = @_; 2736 my @answerList = @_;
2786 my @output; 2737 my @output;
2787 while (@answerList) { 2738 while (@answerList) {
2788 push( @output, strict_str_cmp(shift @answerList) ); 2739 push( @output, strict_str_cmp(shift @answerList) );
2789 } 2740 }
2790 @output; 2741 @output;
2791} 2742}
2792 2743
2793sub unordered_str_cmp { # unordered, case insensitive, spaces ignored 2744sub unordered_str_cmp { # unordered, case insensitive, spaces ignored
2794 my $correctAnswer = shift @_; 2745 my $correctAnswer = shift @_;
2795 my @filters = ( 'ignore_order', 'ignore_case' ); 2746 my @filters = ( 'ignore_order', 'ignore_case' );
2796 my $type = 'unordered_str_cmp'; 2747 my $type = 'unordered_str_cmp';
2797 STR_CMP( 'correctAnswer' => $correctAnswer, 2748 STR_CMP( 'correctAnswer' => $correctAnswer,
2798 'filters' => \@filters, 2749 'filters' => \@filters,
2799 'type' => $type 2750 'type' => $type
2800 ); 2751 );
2801} 2752}
2802 2753
2803sub unordered_str_cmp_list { # alias for unordered_str_cmp 2754sub unordered_str_cmp_list { # alias for unordered_str_cmp
2804 my @answerList = @_; 2755 my @answerList = @_;
2805 my @output; 2756 my @output;
2806 while (@answerList) { 2757 while (@answerList) {
2807 push( @output, unordered_str_cmp(shift @answerList) ); 2758 push( @output, unordered_str_cmp(shift @answerList) );
2808 } 2759 }
2809 @output; 2760 @output;
2810} 2761}
2811 2762
2812sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored 2763sub unordered_cs_str_cmp { # unordered, case sensitive, spaces ignored
2813 my $correctAnswer = shift @_; 2764 my $correctAnswer = shift @_;
2814 my @filters = ( 'ignore_order' ); 2765 my @filters = ( 'ignore_order' );
2815 my $type = 'unordered_cs_str_cmp'; 2766 my $type = 'unordered_cs_str_cmp';
2816 STR_CMP( 'correctAnswer' => $correctAnswer, 2767 STR_CMP( 'correctAnswer' => $correctAnswer,
2817 'filters' => \@filters, 2768 'filters' => \@filters,
2818 'type' => $type 2769 'type' => $type
2819 ); 2770 );
2820} 2771}
2821 2772
2822sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp 2773sub unordered_cs_str_cmp_list { # alias for unordered_cs_str_cmp
2823 my @answerList = @_; 2774 my @answerList = @_;
2824 my @output; 2775 my @output;
2825 while (@answerList) { 2776 while (@answerList) {
2826 push( @output, unordered_cs_str_cmp(shift @answerList) ); 2777 push( @output, unordered_cs_str_cmp(shift @answerList) );
2827 } 2778 }
2828 @output; 2779 @output;
2829} 2780}
2830 2781
2831sub ordered_str_cmp { # ordered, case insensitive, spaces ignored 2782sub ordered_str_cmp { # ordered, case insensitive, spaces ignored
2832 my $correctAnswer = shift @_; 2783 my $correctAnswer = shift @_;
2833 my @filters = ( 'remove_whitespace', 'ignore_case' ); 2784 my @filters = ( 'remove_whitespace', 'ignore_case' );
2834 my $type = 'ordered_str_cmp'; 2785 my $type = 'ordered_str_cmp';
2835 STR_CMP( 'correctAnswer' => $correctAnswer, 2786 STR_CMP( 'correctAnswer' => $correctAnswer,
2836 'filters' => \@filters, 2787 'filters' => \@filters,
2837 'type' => $type 2788 'type' => $type
2838 ); 2789 );
2839} 2790}
2840 2791
2841sub ordered_str_cmp_list { # alias for ordered_str_cmp 2792sub ordered_str_cmp_list { # alias for ordered_str_cmp
2842 my @answerList = @_; 2793 my @answerList = @_;
2843 my @output; 2794 my @output;
2844 while (@answerList) { 2795 while (@answerList) {
2845 push( @output, ordered_str_cmp(shift @answerList) ); 2796 push( @output, ordered_str_cmp(shift @answerList) );
2846 } 2797 }
2847 @output; 2798 @output;
2848
2849} 2799}
2850 2800
2851sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored 2801sub ordered_cs_str_cmp { # ordered, case sensitive, spaces ignored
2852 my $correctAnswer = shift @_; 2802 my $correctAnswer = shift @_;
2853 my @filters = ( 'remove_whitespace' ); 2803 my @filters = ( 'remove_whitespace' );
2854 my $type = 'ordered_cs_str_cmp'; 2804 my $type = 'ordered_cs_str_cmp';
2855 STR_CMP( 'correctAnswer' => $correctAnswer, 2805 STR_CMP( 'correctAnswer' => $correctAnswer,
2856 'filters' => \@filters, 2806 'filters' => \@filters,
2857 'type' => $type 2807 'type' => $type
2858 ); 2808 );
2859} 2809}
2860 2810
2861sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp 2811sub ordered_cs_str_cmp_list { # alias for ordered_cs_str_cmp
2862 my @answerList = @_; 2812 my @answerList = @_;
2863 my @output; 2813 my @output;
2864 while (@answerList) { 2814 while (@answerList) {
2865 push( @output, ordered_cs_str_cmp(shift @answerList) ); 2815 push( @output, ordered_cs_str_cmp(shift @answerList) );
2866 } 2816 }
… …
2901 str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc" 2851 str_cmp( "ABC", filters => 'ignore_order' ) -- matches "ACB", "A B C", but not "abc"
2902 str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed" 2852 str_cmp( "D E F", remove_whitespace, ignore_case ) -- matches "def" and "d e f" but not "fed"
2903 2853
2904=cut 2854=cut
2905 2855
2906sub str_cmp { 2856sub str_cmp {
2907 my $correctAnswer = shift @_; 2857 my $correctAnswer = shift @_;
2908 $correctAnswer = '' unless defined($correctAnswer); 2858 $correctAnswer = '' unless defined($correctAnswer);
2909 my @options = @_; 2859 my @options = @_;
2910 my $ra_filters; 2860 my $ra_filters;
2911 2861
… …
2915 } 2865 }
2916 2866
2917 if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation 2867 if( $options[0] eq 'filters' ) { # using filters => [f1, f2, ...] notation
2918 $ra_filters = $options[1]; 2868 $ra_filters = $options[1];
2919 } 2869 }
2920 else { # using a list of filters 2870 else { # using a list of filters
2921 $ra_filters = \@options; 2871 $ra_filters = \@options;
2922 } 2872 }
2923 2873
2924 # thread over lists 2874 # thread over lists
2925 my @ans_list = (); 2875 my @ans_list = ();
… …
2951## correctAnswer -- the correct answer, before filtering 2901## correctAnswer -- the correct answer, before filtering
2952## filters -- reference to an array containing the filters to be applied 2902## filters -- reference to an array containing the filters to be applied
2953## type -- a string containing the type of answer evaluator in use 2903## type -- a string containing the type of answer evaluator in use
2954## OUT: a reference to an answer evaluator subroutine 2904## OUT: a reference to an answer evaluator subroutine
2955 2905
2956sub STR_CMP { 2906sub STR_CMP {
2957 my %str_params = @_; 2907 my %str_params = @_;
2958 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} ); 2908 $str_params{'correctAnswer'} = str_filters( $str_params{'correctAnswer'}, @{$str_params{'filters'}} );
2959 my $answer_evaluator = sub { 2909 my $answer_evaluator = sub {
2960 my $in = shift @_; 2910 my $in = shift @_;
2961 $in = '' unless defined $in; 2911 $in = '' unless defined $in;
… …
3002 2952
3003# added 6/14/2000 by David Etlinger 2953# added 6/14/2000 by David Etlinger
3004# because of the conversion of the answer 2954# because of the conversion of the answer
3005# string to an array, I thought it better not 2955# string to an array, I thought it better not
3006# to force STR_CMP() to work with this 2956# to force STR_CMP() to work with this
3007sub checkbox_cmp { 2957sub checkbox_cmp {
3008 my $correctAnswer = shift @_; 2958 my $correctAnswer = shift @_;
3009 $correctAnswer = str_filters( $correctAnswer, 'ignore_order' ); 2959 $correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
3010 2960
3011 my $answer_evaluator = sub { 2961 my $answer_evaluator = sub {
3012 my $in = shift @_; 2962 my $in = shift @_;
… …
3049########################################################################## 2999##########################################################################
3050########################################################################## 3000##########################################################################
3051## Text and e-mail routines 3001## Text and e-mail routines
3052 3002
3053 3003
3054sub store_ans_at { 3004sub store_ans_at {
3055 my $answerStringRef = shift; 3005 my $answerStringRef = shift;
3056 my %options = @_; 3006 my %options = @_;
3057 my $ans_eval= ''; 3007 my $ans_eval= '';
3058 if ( ref($answerStringRef) eq 'SCALAR' ) { 3008 if ( ref($answerStringRef) eq 'SCALAR' ) {
3059 $ans_eval= sub { 3009 $ans_eval= sub {
… …
3091 # evaluated. 3041 # evaluated.
3092# this is a utility script for cleaning up the answer output for display in 3042# this is a utility script for cleaning up the answer output for display in
3093#the answers. 3043#the answers.
3094 3044
3095 3045
3096sub DUMMY_ANSWER { 3046sub DUMMY_ANSWER {
3097 my $num = shift; 3047 my $num = shift;
3098 qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">} 3048 qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">}
3099} 3049}
3100 3050
3101sub escapeHTML { 3051sub escapeHTML {
3102 my $string = shift; 3052 my $string = shift;
3103 $string =~ s/\n/$BR/ge; 3053 $string =~ s/\n/$BR/ge;
3104 $string; 3054 $string;
3105} 3055}
3106 3056
3107# these next two subroutines show how to modify the "store_and_at()" answer 3057# these next two subroutines show how to modify the "store_and_at()" answer
3108# evaluator to add extra information before storing the info 3058# evaluator to add extra information before storing the info
3109# They provide a good model for how to tweak answer evaluators in special cases. 3059# They provide a good model for how to tweak answer evaluators in special cases.
3110sub anstext { 3060sub anstext {
3111 my $num = shift; 3061 my $num = shift;
3112 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3062 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
3113 my $ans_eval = sub { 3063 my $ans_eval = sub {
3114 my $text = shift; 3064 my $text = shift;
3115 $text = '' unless defined($text); 3065 $text = '' unless defined($text);
… …
3122 $out; 3072 $out;
3123 }; 3073 };
3124 $ans_eval; 3074 $ans_eval;
3125} 3075}
3126 3076
3127sub ansradio { 3077sub ansradio {
3128 my $num = shift; 3078 my $num = shift;
3129 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS); 3079 my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
3130 my $ans_eval = sub { 3080 my $ans_eval = sub {
3131 my $text = shift; 3081 my $text = shift;
3132 $text = '' unless defined($text); 3082 $text = '' unless defined($text);
… …
3145# the desired behavior in a special case. Here the object is to have 3095# the desired behavior in a special case. Here the object is to have
3146# have the last answer trigger the send_mail_to subroutine which mails 3096# have the last answer trigger the send_mail_to subroutine which mails
3147# all of the answers to the designated address. 3097# all of the answers to the designated address.
3148# (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.) 3098# (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
3149 3099
3150sub mail_answers_to { #accepts the last answer and mails off the result 3100sub mail_answers_to { #accepts the last answer and mails off the result
3151 my $user_address = shift; 3101 my $user_address = shift;
3152 my $ans_eval = sub { 3102 my $ans_eval = sub {
3153 3103
3154 # then mail out all of the answers, including this last one. 3104 # then mail out all of the answers, including this last one.
3155 3105
… …
3169 return $ans_hash; 3119 return $ans_hash;
3170 }; 3120 };
3171 3121
3172 return $ans_eval; 3122 return $ans_eval;
3173} 3123}
3174sub mail_answers_to2 { #accepts the last answer and mails off the result 3124sub mail_answers_to2 { #accepts the last answer and mails off the result
3175 my $user_address = shift; 3125 my $user_address = shift;
3176 my $subject = shift; 3126 my $subject = shift;
3177 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject; 3127 $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
3178 3128
3179 3129
… …
3190 3140
3191########################################################################## 3141##########################################################################
3192########################################################################## 3142##########################################################################
3193## Problem Grader Subroutines 3143## Problem Grader Subroutines
3194 3144
3195
3196##################################### 3145#####################################
3197# This is a model for plug-in problem graders 3146# This is a model for plug-in problem graders
3198##################################### 3147#####################################
3199sub install_problem_grader { 3148sub install_problem_grader {
3200 my $rf_problem_grader = shift; 3149 my $rf_problem_grader = shift;
3201 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $rf_problem_grader; 3150 $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $rf_problem_grader;
3202} 3151}
3203 3152
3204#this is called std only for compatability purposes; 3153#this is called std only for compatability purposes;
3205#almost everyone uses avg_problem_grader 3154#almost everyone uses avg_problem_grader
3206sub std_problem_grader{ 3155sub std_problem_grader {
3207 my $rh_evaluated_answers = shift; 3156 my $rh_evaluated_answers = shift;
3208 my $rh_problem_state = shift; 3157 my $rh_problem_state = shift;
3209 my %form_options = @_; 3158 my %form_options = @_;
3210 my %evaluated_answers = %{$rh_evaluated_answers}; 3159 my %evaluated_answers = %{$rh_evaluated_answers};
3211 # The hash $rh_evaluated_answers typically contains: 3160 # The hash $rh_evaluated_answers typically contains:
… …
3281 3230
3282#the only difference between the two versions 3231#the only difference between the two versions
3283#is at the end of the subroutine, where std_problem_grader2 3232#is at the end of the subroutine, where std_problem_grader2
3284#records the attempt only if there have been no syntax errors, 3233#records the attempt only if there have been no syntax errors,
3285#whereas std_problem_grader records it regardless 3234#whereas std_problem_grader records it regardless
3286sub std_problem_grader2{ 3235sub std_problem_grader2 {
3287 my $rh_evaluated_answers = shift; 3236 my $rh_evaluated_answers = shift;
3288 my $rh_problem_state = shift; 3237 my $rh_problem_state = shift;
3289 my %form_options = @_; 3238 my %form_options = @_;
3290 my %evaluated_answers = %{$rh_evaluated_answers}; 3239 my %evaluated_answers = %{$rh_evaluated_answers};
3291 # The hash $rh_evaluated_answers typically contains: 3240 # The hash $rh_evaluated_answers typically contains:
… …
3362 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; 3311 $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
3363 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; 3312 $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
3364 } 3313 }
3365 else { 3314 else {
3366 $problem_result{show_partial_correct_answers} = 0 ; # prevent partial correct answers from being shown for syntax errors. 3315 $problem_result{show_partial_correct_answers} = 0 ; # prevent partial correct answers from being shown for syntax errors.
3367
3368 } 3316 }
3369
3370 (\%problem_result, \%problem_state); 3317 (\%problem_result, \%problem_state);
3371} 3318}
3372 3319
3373
3374sub avg_problem_grader{ 3320sub avg_problem_grader {
3375 my $rh_evaluated_answers = shift; 3321 my $rh_evaluated_answers = shift;
3376 my $rh_problem_state = shift; 3322 my $rh_problem_state = shift;
3377 my %form_options = @_; 3323 my %form_options = @_;
3378 my %evaluated_answers = %{$rh_evaluated_answers}; 3324 my %evaluated_answers = %{$rh_evaluated_answers};
3379 # The hash $rh_evaluated_answers typically contains: 3325 # The hash $rh_evaluated_answers typically contains:
… …
3425 3371
3426 $problem_state{num_of_correct_ans}++ if $total == $count; 3372 $problem_state{num_of_correct_ans}++ if $total == $count;
3427 $problem_state{num_of_incorrect_ans}++ if $total < $count ; 3373 $problem_state{num_of_incorrect_ans}++ if $total < $count ;
3428 warn "Error in grading this problem the total $total is larger than $count" if $total > $count; 3374 warn "Error in grading this problem the total $total is larger than $count" if $total > $count;
3429 (\%problem_result, \%problem_state); 3375 (\%problem_result, \%problem_state);
3430
3431} 3376}
3432
3433
3434 3377
3435########################################################################### 3378###########################################################################
3436### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT. 3379### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT.
3437
3438 3380
3439## Internal routine that converts variables into the standard array format 3381## Internal routine that converts variables into the standard array format
3440## 3382##
3441## IN: one of the following: 3383## IN: one of the following:
3442## an undefined value (i.e., no variable was specified) 3384## an undefined value (i.e., no variable was specified)
3443## a reference to an array of variable names -- [var1, var2] 3385## a reference to an array of variable names -- [var1, var2]
3444## a number (the number of variables desired) -- 3 3386## a number (the number of variables desired) -- 3
3445## one or more variable names -- (var1, var2) 3387## one or more variable names -- (var1, var2)
3446## OUT: an array of variable names 3388## OUT: an array of variable names
3389
3447sub get_var_array { 3390sub get_var_array {
3448 my $in = shift @_; 3391 my $in = shift @_;
3449 my @out; 3392 my @out;
3450 3393
3451 if( not defined($in) ) { #if nothing defined, build default array and return 3394 if( not defined($in) ) { #if nothing defined, build default array and return
… …
3469 $out[2] = 'z'; 3412 $out[2] = 'z';
3470 } 3413 }
3471 else { #default to the x_1, x_2, ... convention 3414 else { #default to the x_1, x_2, ... convention
3472 my ($i, $tag); 3415 my ($i, $tag);
3473 for( $i=0; $i < $in; $i++ ) { 3416 for( $i=0; $i < $in; $i++ ) {
3474 ## akp the above seems to be off by one 1/4/00 3417 ## akp the above seems to be off by one 1/4/00
3475 $tag = $i + 1; ## akp 1/4/00 3418 $tag = $i + 1; ## akp 1/4/00
3476 $out[$i] = "${functVarDefault}_" . $tag; ## akp 1/4/00 3419 $out[$i] = "${functVarDefault}_" . $tag; ## akp 1/4/00
3477 } 3420 }
3478 } 3421 }
3479
3480 return @out; 3422 return @out;
3481 } 3423 }
3482 else { #if given one or more names, return as an array 3424 else { #if given one or more names, return as an array
3483 unshift( @_, $in ); 3425 unshift( @_, $in );
3484
3485 return @_; 3426 return @_;
3486 } 3427 }
3487} 3428}
3488 3429
3489## Internal routine that converts limits into the standard array of arrays format 3430## Internal routine that converts limits into the standard array of arrays format
… …
3499 3440
3500sub get_limits_array { 3441sub get_limits_array {
3501 my $in = shift @_; 3442 my $in = shift @_;
3502 my @out; 3443 my @out;
3503 3444
3504 if( not defined($in) ) { #if nothing defined, build default array and return 3445 if( not defined($in) ) { #if nothing defined, build default array and return
3505 @out = ( [$functLLimitDefault, $functULimitDefault] ); 3446 @out = ( [$functLLimitDefault, $functULimitDefault] );
3506 return @out; 3447 return @out;
3507 } 3448 }
3508 elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs 3449 elsif( ref($in) eq 'ARRAY' ) { #$in is either ref to array, or ref to array of refs
3509 my @deref = @{$in}; 3450 my @deref = @{$in};
3510 3451
3511 if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs 3452 if( ref( $in->[0] ) eq 'ARRAY' ) { #$in is a ref to an array of array refs
3512 return @deref; 3453 return @deref;
3513 } 3454 }
3514 else { #$in was just a ref to an array of numbers 3455 else { #$in was just a ref to an array of numbers
3515 @out = ( $in ); 3456 @out = ( $in );
3516 return @out; 3457 return @out;
3517 } 3458 }
3518 } 3459 }
3519 else { #$in was an array of references or numbers 3460 else { #$in was an array of references or numbers
3520 unshift( @_, $in ); 3461 unshift( @_, $in );
3521 3462
3522 if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it 3463 if( ref($_[0]) eq 'ARRAY' ) { #$in was an array of references, so just return it
3523 return @_; 3464 return @_;
3524 } 3465 }
3525 else { #$in was an array of numbers 3466 else { #$in was an array of numbers
3526 @out = ( \@_ ); 3467 @out = ( \@_ );
3527 return @out; 3468 return @out;
3528 } 3469 }
3529 } 3470 }
3530} 3471}
3531 3472
3532sub check_option_list { 3473sub check_option_list {
3533 my $size = scalar(@_); 3474 my $size = scalar(@_);
3534 if( ( $size % 2 ) != 0 ) { 3475 if( ( $size % 2 ) != 0 ) {
3535 warn "ERROR in answer evaluator generator:\n" . 3476 warn "ERROR in answer evaluator generator:\n" .
3536 "Usage: <CODE>str_cmp([\$ans1, \$ans2],%options)</CODE> 3477 "Usage: <CODE>str_cmp([\$ans1, \$ans2],%options)</CODE>
3537 or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR> 3478 or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR>
… …
3542# simple subroutine to display an error message when 3483# simple subroutine to display an error message when
3543# function compares are called with invalid parameters 3484# function compares are called with invalid parameters
3544sub function_invalid_params { 3485sub function_invalid_params {
3545 my $correctEqn = shift @_; 3486 my $correctEqn = shift @_;
3546 my $error_response = sub { 3487 my $error_response = sub {
3547 my $PGanswerMessage = "Tell your professor that there is an error with the parameters " . 3488 my $PGanswerMessage = "Tell your professor that there is an error with the parameters " .
3548 "to the function answer evaluator"; 3489 "to the function answer evaluator";
3549 return ( 0, $correctEqn, "", $PGanswerMessage ); 3490 return ( 0, $correctEqn, "", $PGanswerMessage );
3550 }; 3491 };
3551
3552 return $error_response; 3492 return $error_response;
3553} 3493}
3554
3555 3494
3556######################################################################### 3495#########################################################################
3557# Filters for answer evaluators 3496# Filters for answer evaluators
3558######################################################################### 3497#########################################################################
3559 3498
3560
3561sub is_a_number { 3499sub is_a_number {
3562 my ($num,%options) = @_; 3500 my ($num,%options) = @_;
3563 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3501 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3564 my ($rh_ans); 3502 my ($rh_ans);
3565 if ($process_ans_hash) { 3503 if ($process_ans_hash) {
3566 $rh_ans = $num; 3504 $rh_ans = $num;
… …
3589 } else { 3527 } else {
3590 return $is_a_number; 3528 return $is_a_number;
3591 } 3529 }
3592} 3530}
3593 3531
3594sub is_a_fraction { 3532sub is_a_fraction {
3595 my ($num,%options) = @_; 3533 my ($num,%options) = @_;
3596 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3534 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3597 my ($rh_ans); 3535 my ($rh_ans);
3598 if ($process_ans_hash) { 3536 if ($process_ans_hash) {
3599 $rh_ans = $num; 3537 $rh_ans = $num;
… …
3623 return $is_a_fraction; 3561 return $is_a_fraction;
3624 } 3562 }
3625} 3563}
3626 3564
3627 3565
3628sub is_an_arithmetic_expression { 3566sub is_an_arithmetic_expression {
3629 my ($num,%options) = @_; 3567 my ($num,%options) = @_;
3630 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 3568 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
3631 my ($rh_ans); 3569 my ($rh_ans);
3632 if ($process_ans_hash) { 3570 if ($process_ans_hash) {
3633 $rh_ans = $num; 3571 $rh_ans = $num;
… …
3658 return $is_an_arithmetic_expression; 3596 return $is_an_arithmetic_expression;
3659 } 3597 }
3660} 3598}
3661 3599
3662#replaces pi, e, and ^ with their Perl equivalents 3600#replaces pi, e, and ^ with their Perl equivalents
3663sub math_constants { 3601sub math_constants {
3664 my($in,%options) = @_; 3602 my($in,%options) = @_;
3665 my $rh_ans; 3603 my $rh_ans;
3666 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ; 3604 my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
3667 if ($process_ans_hash) { 3605 if ($process_ans_hash) {
3668 $rh_ans = $in; 3606 $rh_ans = $in;
… …
3679 } else { 3617 } else {
3680 return $in; 3618 return $in;
3681 } 3619 }
3682} 3620}
3683 3621
3684sub clean_up_error_msg { 3622sub clean_up_error_msg {
3685 my $msg = $_[0]; 3623 my $msg = $_[0];
3686 $msg =~ s/^\[[^\]]*\][^:]*://; 3624 $msg =~ s/^\[[^\]]*\][^:]*://;
3687 $msg =~ s/Unquoted string//g; 3625 $msg =~ s/Unquoted string//g;
3688 $msg =~ s/may\s+clash.*/does not make sense here/; 3626 $msg =~ s/may\s+clash.*/does not make sense here/;
3689 $msg =~ s/\sat.*line [\d]*//g; 3627 $msg =~ s/\sat.*line [\d]*//g;
… …
3694 3632
3695#formats the student and correct answer as specified 3633#formats the student and correct answer as specified
3696#format must be of a form suitable for sprintf (e.g. '%0.5g'), 3634#format must be of a form suitable for sprintf (e.g. '%0.5g'),
3697#with the exception that a '#' at the end of the string 3635#with the exception that a '#' at the end of the string
3698#will cause trailing zeros in the decimal part to be removed 3636#will cause trailing zeros in the decimal part to be removed
3699sub prfmt { 3637sub prfmt {
3700 my($number,$format) = @_; # attention, the order of format and number are reversed 3638 my($number,$format) = @_; # attention, the order of format and number are reversed
3701 my $out; 3639 my $out;
3702 if ($format) { 3640 if ($format) {
3703 warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>" 3641 warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>"
3704 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/; 3642 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/;
3705 3643
3706 if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal 3644 if( $format =~ s/#\s*$// ) { # remove trailing zeros in the decimal
3707 $out = sprintf( $format, $number ); 3645 $out = sprintf( $format, $number );
3708 $out =~ s/(\.\d*?)0+$/$1/; 3646 $out =~ s/(\.\d*?)0+$/$1/;
3709 $out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal 3647 $out =~ s/\.$//; # in case all decimal digits were zero, remove the decimal
3710 } 3648 }
3711 else { 3649 else {
3712 $out = sprintf( $format, $number ); 3650 $out = sprintf( $format, $number );
3713 } 3651 }
3714
3715 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3652 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3716 } 3653 }
3717 else { 3654 else {
3718 $out = $number; 3655 $out = $number;
3719 } 3656 }
3720
3721 return $out; 3657 return $out;
3722} 3658}
3723 3659
3724=head4 3660=head4
3725 3661
… …
3789 } else { 3725 } else {
3790 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n", 3726 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
3791 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias}, 3727 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
3792 " was ignored."; 3728 " was ignored.";
3793 } 3729 }
3794
3795 } 3730 }
3796 delete($rh_options->{$alias}); # remove the alias from the initial list 3731 delete($rh_options->{$alias}); # remove the alias from the initial list
3797 } 3732 }
3798 3733
3799} 3734}
Legend:
Removed from v.53  
changed lines
  Added in v.54
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9