[system] / trunk / pg / macros / extraAnswerEvaluators.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/extraAnswerEvaluators.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2143 - (download) (as text) (annotate)
Fri May 21 23:56:48 2004 UTC (15 years, 6 months ago) by apizer
File size: 26589 byte(s)
Use the new PGsort which uses a true/false compare (e.g. < or lt )
rather than a -1,0,1 compare (e.g. <=> or cmp ).

Arnie

    1 
    2 
    3 # This is extraAnswerEvaluators.pl
    4 
    5 # Most of the work is done in special namespaces
    6 # At the end, we provide one global function, the interval answer evaluator
    7 
    8 # To do:
    9 #    Convert these to AnswerEvaluator objects
   10 #    Better error checking/messages
   11 #    Simplify checks so we don't make so much use of num_cmp and cplx_cmp.
   12 #      When they change, these functions may have to change.
   13 
   14 =head1 NAME
   15 
   16         extraAnswerEvaluators.pl -- located in the courseScripts directory
   17 
   18 =head1 SYNPOSIS
   19 
   20         Answer Evaluators for intervals, lists of numbers, lists of points,
   21         and equations.
   22 
   23   interval_cmp() -- checks answers which are unions of intervals.
   24                     It can also be used for checking an ordered pair or
   25                     list of ordered pairs.
   26 
   27   number_list_cmp() -- checks a comma separated list of numbers.  By use of
   28                        optional arguments, you can request that order be
   29                        important, that complex numbers be allowed, and
   30                        specify extra arguments to be sent to num_cmp (or
   31                        cplx_cmp) for checking individual entries.
   32 
   33   equation_cmp() -- provides a limited facility for checking equations.
   34                     It makes no pretense of checking to see if the real locus
   35                     of the student's equation matches the real locus of the
   36                     instructor's equation.  The student's equation must be
   37                     of the same general type as the instructors to get credit.
   38 
   39 
   40 =cut
   41 
   42 =head1 DESCRIPTION
   43 
   44 This file adds subroutines which create "answer evaluators" for checking student
   45 answers of various "exotic" types.
   46 
   47 =cut
   48 
   49 
   50 {
   51  package Intervals;
   52 
   53  # We accept any of the following as infinity (case insensitive)
   54  @infinitywords = ("i", "inf", "infty", "infinity");
   55  $infinityre = join '|', @infinitywords;
   56  $infinityre = "^([-+m]?)($infinityre)\$";
   57 
   58  sub new {
   59    my $class = shift;
   60    my $base_string = shift;
   61    my $self = {};
   62    $self->{'original'} = $base_string;
   63    return bless $self, $class;
   64  }
   65 
   66  # Not object oriented.  It just returns the structure
   67  sub new_interval {         # must call with 4 arguments
   68    my($l,$r,$lec, $rec) = @_;
   69    return [[$l,$r],[$lec,$rec]];
   70  }
   71 
   72  # error routine copied from AlgParser
   73  sub error {
   74    my($self, @args) = @_;
   75    # we cheat to use error from algparser
   76    my($ap) = new AlgParser();
   77    $ap->inittokenizer($self->{'original'});
   78    $ap->error(@args);
   79    $self->{htmlerror} =  $ap->{htmlerror};
   80    $self->{error_msg} = $ap->{error_msg};
   81  }
   82 
   83  # Determine if num_cmp detected a parsing/syntax type error
   84 
   85  sub has_errors {
   86    my($ah) = shift;
   87 
   88    if($ah->{'student_ans'} =~ /error/) {
   89      return 1;
   90    }
   91    my($am) = $ah->{'ans_message'};
   92    if($am =~ /error/) {
   93      return 2;
   94    }
   95    if($am =~ /must enter/) {
   96      return 3;
   97    }
   98    if($am =~ /does not evaluate/) {
   99      return 4;
  100    }
  101    return 0;
  102  }
  103 
  104 
  105  ## Parse a string into a bunch of intervals
  106  ## We do it by hand to avoid problems of nested parentheses
  107  ## This also builds a normalized version of the string, one with values,
  108  ## and a latex version.
  109  ##
  110  ## Return value simply says whether or not this was successful
  111  sub parse_intervals {
  112    my($self) = shift;
  113    my(%opts) = @_;
  114    my($str) = $self->{'original'};
  115    my(@ans_list) = ();
  116    delete($opts{'sloppy'});
  117    delete($opts{'ordered'});
  118    my($unions) = 1;
  119    if (defined($opts{'unions'}) and ($opts{'unions'} eq 'no')) {
  120      $unions = 0;
  121    }
  122    # Sometimes we use this for lists of points
  123    delete($opts{'unions'});
  124    my($b1str,$b2str) = (', ', ', ');
  125    if($unions) {
  126      ($b1str,$b2str) = (' U ', ' \cup ');
  127    }
  128 
  129    my($tmp_ae) = main::num_cmp(1, %opts);
  130    $self->{'normalized'} = '';
  131    $self->{'value'} = '';
  132    $self->{'latex'} = '';
  133    $self->{'htmlerror'} = '';
  134    $self->{'error_msg'} = '';
  135    my($pmi) = 0;
  136    my(@cur) = ("","");
  137    my($lb,$rb) = (0,0);
  138    my($level,$spot,$hold,$char,$lr) = (0,0,0,"a",0);
  139 
  140    while ($spot < length($str)) {
  141      $char = substr($str,$spot,1);
  142      if ($char=~ /[\[(,)\]]/) { # Its a special character
  143        if ($char eq ",") {
  144          if ($level == 1) {     # Level 1 comma
  145            if ($lr == 1) {
  146              $self->error("Not a valid interval; too many commas.",[$spot]);
  147              return 0;
  148            } else {
  149              $lr=1;
  150              $cur[0] = substr($str,$hold, $spot-$hold);
  151              if($pmi = pminf($cur[0])) {
  152                if($pmi<0) {
  153                  $self->{'value'} .= '-';
  154                  $self->{'normalized'} .= '-';
  155                  $self->{'latex'} .= '-';
  156                }
  157                $self->{'value'} .= 'Infinity, ';
  158                $self->{'normalized'} .= 'Infinity, ';
  159                $self->{'latex'} .= '\infty, ';
  160              } else {
  161                my($tmp_ah) = $tmp_ae->evaluate($cur[0]);
  162                if(has_errors($tmp_ah)) {
  163                  $self->error("I could not parse your input correctly",[$hold, $spot]);
  164                  return 0;
  165                }
  166                $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}.", ";
  167                $self->{'value'} .= $tmp_ah->{'student_ans'}.", ";
  168                $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}.", ";
  169              }
  170              $hold = $spot+1;
  171            }
  172          }
  173        }                        # end of comma
  174        elsif ($char eq "[" or $char eq "(") { #opening
  175          if ($level==0) {
  176            $lr = 0;
  177            if(scalar(@ans_list)) { # this is not the first interval
  178              $self->{'normalized'} .= $b1str;
  179              $self->{'value'} .= $b1str;
  180              $self->{'latex'} .= $b2str;
  181            }
  182            $self->{'normalized'} .= "$char";
  183            $self->{'value'} .= "$char";
  184            $self->{'latex'} .= "$char";
  185            $hold=$spot+1;
  186            if ($char eq "[") {
  187              $lb = 1;
  188            } else {
  189              $lb = 0;
  190            }
  191          }
  192          $level++;
  193        }                        # end of open paren
  194        else {                   # must be closed paren
  195          if ($level == 0) {
  196            $self->error("Not a valid interval; extra $char when I expected a new interval to open.",[$spot]);
  197            return 0;
  198          } elsif ($level == 1) {
  199            if ($lr != 1) {
  200              $self->error("Not a valid interval; closing an interval without a right component.", [$spot]);
  201              return 0;
  202            } else {
  203              $cur[1] = substr($str, $hold, $spot-$hold);
  204              if($pmi = pminf($cur[1])) {
  205                if($pmi<0) {
  206                  $self->{'value'} .= '-';
  207                  $self->{'normalized'} .= '-';
  208                  $self->{'latex'} .= '-';
  209                }
  210                $self->{'value'} .= "Infinity$char";
  211                $self->{'normalized'} .= "Infinity$char";
  212                $self->{'latex'} .= '\infty'."$char";
  213                } else {
  214                my($tmp_ah) = $tmp_ae->evaluate($cur[1]);
  215                if(has_errors($tmp_ah)) {
  216                  $self->error("I could not parse your input correctly",[$hold, $spot]);
  217                  return 0;
  218                }
  219                $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}."$char";
  220                $self->{'value'} .= $tmp_ah->{'student_ans'}."$char";
  221                $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}."$char";
  222              }
  223              if ($char eq "]") {
  224                $rb = 1;
  225              } else {
  226                $rb = 0;
  227              }
  228              push @ans_list, new_interval($cur[0], $cur[1], $lb, $rb);
  229            }
  230          }
  231          $level--;
  232        }
  233      }
  234      $spot++;
  235    }
  236 
  237    if($level>0) {
  238      $self->error("Your expression ended in the middle of an interval.",
  239                   [$hold, $spot]);
  240      return 0;
  241    }
  242    $self->{'parsed'} = \@ans_list;
  243    return 1;
  244  }
  245 
  246  # Is the argument an exceptable +/- infinity
  247  # Its sort of multiplies the input by 0 using 0 * oo = 1, 0 * (-oo) = -1.
  248  sub pminf {
  249    my($val) = shift;
  250    $val = "\L$val";             # lowercase
  251    $val =~ s/ //g;              # remove space
  252    if ($val =~ /$infinityre/) {
  253      if (($1 eq '-') or ($1 eq 'm')) {
  254        return -1;
  255      } else {
  256        return 1;
  257      }
  258    }
  259    return 0;
  260  }
  261 
  262  # inputs are now of type Intervals, and then options
  263 
  264  sub cmp_intervals {
  265    my($in1) = shift;
  266    my($in2) = shift;
  267    my(%opts) = @_;
  268    my($strict_ordering) = 0;
  269    if (defined($opts{'ordering'}) && $opts{'ordering'} eq 'strict') {
  270      $strict_ordering = 1;
  271    }
  272    delete($opts{'ordering'});
  273 
  274    my($issloppy) = 0;
  275    if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
  276      $issloppy = 1;
  277    }
  278    delete($opts{'sloppy'});
  279 
  280    delete($opts{'unions'});
  281 
  282 
  283    my(@i1) = @{$in1->{'parsed'}};
  284    my(@i2) = @{$in2->{'parsed'}};
  285 
  286    my($j,$pm10,$pm11,$pm20,$pm21);
  287    # Same number of intervals?
  288    if (scalar(@i1) != scalar(@i2)) {
  289      return 0;
  290    }
  291    for ($j=0; $j<scalar(@i1);$j++) {
  292      my($lbound) = 0;
  293      my($ubound) = scalar(@i1)-1;
  294      my($lookformatch) = 1;
  295      if ($strict_ordering) {
  296        $lbound = $j;
  297        $ubound = $j;
  298      }
  299      for ($k=$lbound; $lookformatch && $k<=$ubound; $k++) {
  300        # Do they all have correct inclusions ()[]?
  301        if (! $issloppy and ($i1[$j]->[1][0] != $i2[$k]->[1][0] or
  302            $i1[$j]->[1][1] != $i2[$k]->[1][1])) {
  303          next;
  304        }
  305        $pm10 = pminf($i1[$j]->[0][0]);
  306        $pm11 = pminf($i1[$j]->[0][1]);
  307        $pm20 = pminf($i2[$k]->[0][0]);
  308        $pm21 = pminf($i2[$k]->[0][1]);
  309        if ($pm10 != $pm20) {
  310          next;
  311        }
  312        if ($pm11 != $pm21) {
  313          next;
  314        }
  315        # Now we deal with only numbers, no infinities
  316        if ($pm10 == 0) {
  317 #        $opts{'correctAnswer'} = $i1[$j]->[0][0];
  318          my $ae = main::num_cmp($i1[$j]->[0][0], %opts);
  319          my $result = $ae->evaluate($i2[$k]->[0][0]);
  320          if ($result->{score} == 0) {
  321            next;
  322          }
  323        }
  324        if ($pm11 == 0) {
  325 #        $opts{'correctAnswer'} = $i1[$j]->[0][1];
  326          my $ae = main::num_cmp($i1[$j]->[0][1], %opts);
  327          my $result = $ae->evaluate($i2[$k]->[0][1]);
  328          if ($result->{score} == 0) {
  329            next;
  330          }
  331        }
  332        $lookformatch=0;
  333      }
  334      if ($lookformatch) {       # still looking ...
  335        return 0;
  336      }
  337    }
  338    return 1;
  339  }
  340 
  341  sub show_int {
  342    my($intt) = shift;
  343    my($intstring) = "";
  344    return "|$intt->[0]->[0]%%$intt->[0]->[1]|";
  345  }
  346 
  347 
  348 
  349 } # End of package Intervals
  350 
  351 {
  352   package Interval_evaluator;
  353 
  354   sub nicify_string {
  355     my $str = shift;
  356 
  357     $str = uc($str);
  358     $str =~ s/\s//g; # remove white space
  359     $str;
  360     }
  361 
  362   #####  The answer evaluator
  363 
  364   sub interval_cmp {
  365 
  366     my $right_ans = shift;
  367     my %opts = @_;
  368 
  369     $opts{'mode'} = 'std' unless defined($opts{'mode'});
  370     $opts{'tolType'} = 'relative' unless defined($opts{'tolType'});
  371 
  372     my $ans_eval = sub {
  373       my $student = shift;
  374 
  375       my $ans_hash = new AnswerHash(
  376                                     'score'=>0,
  377                                     'correct_ans'=>$right_ans,
  378                                     'student_ans'=>$student,
  379                                     'original_student_ans' => $student,
  380                                     # 'type' => undef,
  381                                     'ans_message'=>'',
  382                                     'preview_text_string'=>'',
  383                                     'preview_latex_string'=>'',
  384                                    );
  385       # Handle string matches separately
  386       my($studentisstring, $correctisstring, $tststr) = (0,0,"");
  387       my($nicestud, $nicecorrect) = (nicify_string($student),
  388                                      nicify_string($right_ans));
  389       if(defined($opts{'strings'})) {
  390         for $tststr (@{$opts{'strings'}}) {
  391           $tststr = nicify_string($tststr);
  392           if(($tststr eq $nicestud)) {$studentisstring=1;}
  393           if(($tststr eq $nicecorrect)) {$correctisstring=1;}
  394         }
  395         if($studentisstring) {
  396           $ans_hash->{'preview_text_string'} = $student;
  397           $ans_hash->{'preview_latex_string'} = $student;
  398         }
  399       }
  400       my($student_int, $correct_int);
  401       if(!$studentisstring) {
  402         $student_int = new Intervals($student);
  403         if(! $student_int->parse_intervals(%opts)) {
  404           # Error in student input
  405           $ans_hash->{'student_ans'} = "error:  $student_int->{htmlerror}";
  406           $ans_hash->{'ans_message'} = "$student_int->{error_msg}";
  407           return $ans_hash;
  408         }
  409 
  410         $ans_hash->{'student_ans'} = $student_int->{'value'};
  411         $ans_hash->{'preview_text_string'} = $student_int->{'normalized'};
  412         $ans_hash->{'preview_latex_string'} = $student_int->{'latex'};
  413       }
  414 
  415       if(!$correctisstring) {
  416         $correct_int = new Intervals($right_ans);
  417         if(! $correct_int->parse_intervals(%opts)) {
  418           # Cannot parse instuctor's answer!
  419           $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
  420           return $ans_hash;
  421         }
  422       }
  423       if($correctisstring || $studentisstring) {
  424         if($nicestud eq $nicecorrect) {
  425           $ans_hash -> setKeys('score' => 1);
  426         }
  427       } else {
  428         if (Intervals::cmp_intervals($correct_int, $student_int, %opts)) {
  429           $ans_hash -> setKeys('score' => 1);
  430         }
  431       }
  432 
  433       return $ans_hash;
  434     };
  435 
  436     return $ans_eval;
  437   }
  438 
  439 }
  440 
  441 
  442 {
  443  package Number_List;
  444 
  445  sub new {
  446    my $class = shift;
  447    my $base_string = shift;
  448    my $self = {};
  449    $self->{'original'} = $base_string;
  450    return bless $self, $class;
  451  }
  452 
  453  sub make_complex_number {
  454    my $instring = shift;
  455 
  456    $instring = main::math_constants($instring);
  457    $instring =~ s/e\^/exp /g;
  458    my $parser = new AlgParserWithImplicitExpand;
  459    my $ret = $parser -> parse($instring);
  460    $parser -> tostring();
  461    $parser -> normalize();
  462    $instring = $parser -> tostring();
  463    $instring =~ s/\bi\b/(i)/g;
  464    my ($in,$PG_errors,$PG_errors_long) = main::PG_restricted_eval($instring);
  465    return ($in+0*Complex1::i());
  466  }
  467 
  468 
  469 
  470  sub parse_number_list {
  471    my($self) = shift;
  472    my(%opts) = @_;
  473    my($str) = $self->{'original'};
  474    my(@ans_list) = ();
  475    my(@sort_list) = ();
  476    delete($opts{'ordered'});
  477 
  478    my $complex=0;
  479    if(defined($opts{'complex'}) &&
  480       ($opts{'complex'} =~ /(yes|ok)/i)) {
  481      $complex=1;
  482      delete($opts{'mode'});
  483    }
  484    delete($opts{'complex'});
  485    $self->{'normalized'} = '';
  486    $self->{'value'} = '';
  487    $self->{'latex'} = '';
  488    $self->{'htmlerror'} = '';
  489    $self->{'error_msg'} = '';
  490    my($cur) = "";
  491    my($level,$spot,$hold,$char) = (1,0,0,"a");
  492    my($strt, $end) = (0, length($str));
  493    my($specials) = '[\(\[\]\),\{\}]';
  494    my($tmp_ae,$tmp_ae2);
  495    if($complex) {
  496      $tmp_ae = main::cplx_cmp(new Complex(1,0), %opts);
  497      $tmp_ae2 = main::cplx_cmp(new Complex(1,0));
  498    } else {
  499      $tmp_ae = main::num_cmp(1, %opts);
  500      $tmp_ae2 = main::num_cmp(1);
  501    }
  502 
  503    while ($spot < $end) {
  504      $char = substr($str,$spot,1);
  505      if ($char=~ /$specials/) { # Its a special character
  506        if ($char eq ",") {
  507          if ($level == 1) {     # Level 1 comma
  508              $cur = substr($str,$hold, $spot-$hold);
  509              my($tmp_ah);
  510              $tmp_ah = $tmp_ae->evaluate($cur);
  511              if(has_errors($tmp_ah)) {
  512                $self->error("I could not parse your input correctly",[$hold, $spot]);
  513                return 0;
  514              }
  515              $self->{'normalized'} .= (defined($tmp_ah->{'preview_text_string'}) ? $tmp_ah->{'preview_text_string'} : $tmp_ah->{'student_ans'}).", ";
  516              $self->{'value'} .= $tmp_ah->{'student_ans'}.", ";
  517              $self->{'latex'} .= (defined($tmp_ah->{'preview_latex_string'}) ? $tmp_ah->{'preview_latex_string'} : $tmp_ah->{'student_ans'}).", ";
  518              $tmp_ah = $tmp_ae2->evaluate($cur);
  519              $hold = $spot+1;
  520              push @sort_list, [$cur,$tmp_ah->{'student_ans'}];
  521              push @ans_list, $cur;
  522            }
  523        }      # end of comma
  524        elsif ($char eq "[" or $char eq "(" or $char eq "{") { #opening
  525          $level++;
  526        }                        # end of open paren
  527        else {                   # must be closing paren
  528          if ($level == 1) {
  529            $self->error("Not a valid entry; unmatched $char.",[$spot]);
  530            return 0;
  531          } # end of level <= 1
  532          $level--;
  533        } # end of closing brace
  534      }
  535      $spot++;
  536    }
  537 
  538    if($level>1) {
  539      $self->error("Your expression has unmatched parens.",
  540                   [$hold, $spot]);
  541      return 0;
  542    }
  543    $cur = substr($str,$hold, $spot-$hold);
  544 
  545    my($tmp_ah);
  546    $tmp_ah = $tmp_ae->evaluate($cur);
  547 
  548    if(has_errors($tmp_ah)) {
  549      $self->error("I could not parse your input correctly",[$hold, $spot]);
  550      return 0;
  551    }
  552    if(not ($cur =~ /\w/)) { # Input was empty
  553      $self->{'forsort'} = [];
  554      return 1;
  555    }
  556 
  557    $self->{'normalized'} .= defined($tmp_ah->{'preview_text_string'}) ? $tmp_ah->{'preview_text_string'} : $tmp_ah->{'student_ans'};
  558    $self->{'value'} .= $tmp_ah->{'student_ans'};
  559    $self->{'latex'} .= defined($tmp_ah->{'preview_latex_string'}) ? $tmp_ah->{'preview_latex_string'} : $tmp_ah->{'student_ans'};
  560    if((3==4) && $complex) {
  561      $tmp_ah =&{$tmp_ae2}($cur);
  562    } else {
  563      $tmp_ah = $tmp_ae2->evaluate($cur);
  564    }
  565    $hold = $spot+1;
  566    push @sort_list, [$cur, $tmp_ah->{'student_ans'}];
  567    push @ans_list, $cur;
  568 
  569    $self->{'parsed'} = \@ans_list;
  570    $self->{'forsort'} = \@sort_list;
  571    return 1;
  572  }
  573 
  574  sub number_list_cmp {
  575     my $right_ans = shift;
  576     my %opts = @_;
  577 
  578     $opts{'mode'} = 'std' unless defined($opts{'mode'});
  579     $opts{'tolType'} = 'relative' unless defined($opts{'tolType'});
  580 
  581     my $ans_eval = sub {
  582       my $student = shift;
  583 
  584       my $ans_hash = new AnswerHash(
  585                                     'score'=>0,
  586                                     'correct_ans'=>$right_ans,
  587                                     'student_ans'=>$student,
  588                                     'original_student_ans' => $student,
  589                                     # 'type' => undef,
  590                                     'ans_message'=>'',
  591                                     'preview_text_string'=>'',
  592                                     'preview_latex_string'=>'',
  593                                    );
  594       my $student_list = new Number_List($student);
  595       if(! $student_list->parse_number_list(%opts)) {
  596         # Error in student input
  597         $ans_hash->{'student_ans'} = "error:  $student_list->{htmlerror}";
  598         $ans_hash->{'ans_message'} = "$student_list->{error_msg}";
  599         return $ans_hash;
  600       }
  601 
  602       $ans_hash->{'student_ans'} = $student_list->{'value'};
  603       $ans_hash->{'preview_text_string'} = $student_list->{'normalized'};
  604       $ans_hash->{'preview_latex_string'} = $student_list->{'latex'};
  605 
  606       my $correct_list = new Number_List($right_ans);
  607       if(! $correct_list->parse_number_list(%opts)) {
  608         # Cannot parse instuctor's answer!
  609         $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
  610         return $ans_hash;
  611       }
  612       if (cmp_numlists($correct_list, $student_list, %opts)) {
  613         $ans_hash -> setKeys('score' => 1);
  614       }
  615 
  616       return $ans_hash;
  617     };
  618 
  619     return $ans_eval;
  620   }
  621 
  622  sub sorting_sub {
  623    $_[0]->[1] <=> $_[1]->[1];
  624  }
  625 
  626  sub cmp_numlists {
  627    my($in1) = shift;
  628    my($in2) = shift;
  629    my(%opts) = @_;
  630    my($strict_ordering) = 0;
  631    if (defined($opts{'ordered'}) && ($opts{'ordered'} eq 'yes')) {
  632      $strict_ordering = 1;
  633    }
  634    delete($opts{'ordered'});
  635 
  636    my $complex=0;
  637    if(defined($opts{'complex'}) &&
  638       ($opts{'complex'} =~ /(yes|ok)/i)) {
  639      $complex=1;
  640      delete($opts{'mode'});
  641    }
  642    delete($opts{'complex'});
  643 
  644    my(@fs1) = @{$in1->{'forsort'}};
  645    my(@fs2) = @{$in2->{'forsort'}};
  646 
  647 
  648    # Same number of values?
  649    if (scalar(@fs1) != scalar(@fs2)) {
  650      return 0;
  651    }
  652 
  653    my($j);
  654    if($complex) {
  655      for $j (@fs1) {$j->[1] = make_complex_number($j->[1]);}
  656      for $j (@fs2) {$j->[1] = make_complex_number($j->[1]);}
  657    }
  658 
  659    if($strict_ordering==0) {
  660      @fs1 = main::PGsort(sub {$_[0]->[1] <=$_[1]->[1];}, @fs1);
  661      @fs2 = main::PGsort(sub {$_[0]->[1] < $_[1]->[1];}, @fs2);
  662    }
  663 
  664    for ($j=0; $j<scalar(@fs1);$j++) {
  665      my $ae;
  666      if($complex) {
  667        $ae = main::cplx_cmp($fs1[$j]->[1], %opts);
  668      } else {
  669        $ae = main::num_cmp($fs1[$j]->[0], %opts);
  670      }
  671      my $result;
  672      if($complex) {
  673        $result =$ae->evaluate($fs2[$j]->[1]);
  674      } else {
  675        $result = $ae->evaluate($fs2[$j]->[0]);
  676      }
  677      if ($result->{score} == 0) {
  678        return 0;
  679      }
  680    }
  681    return 1;
  682  }
  683 
  684  # error routine copied from AlgParser
  685  sub error {
  686    my($self, @args) = @_;
  687    # we cheat to use error from algparser
  688    my($ap) = new AlgParser();
  689    $ap->inittokenizer($self->{'original'});
  690    $ap->error(@args);
  691    $self->{htmlerror} =  $ap->{htmlerror};
  692    $self->{error_msg} = $ap->{error_msg};
  693  }
  694 
  695  sub has_errors {
  696    my($ah) = shift;
  697 
  698    if($ah->{'student_ans'} =~ /error/) {
  699      return 1;
  700    }
  701    my($am) = $ah->{'ans_message'};
  702    if($am =~ /error/) {
  703      return 2;
  704    }
  705    if($am =~ /must enter/) {
  706      return 3;
  707    }
  708    if($am =~ /does not evaluate/) {
  709      return 4;
  710    }
  711    return 0;
  712  }
  713 
  714 # Syntax is
  715 #     interval_cmp("[1,2) U [3, infty)", options)
  716 # where options are key/value pairs for num_cmp.  Also, we allow the option
  717 # 'ordering' which can be 'strict', which means that we do not want to test rearrangements
  718 # of the intervals.
  719 
  720 
  721 }
  722 
  723 {
  724   package Equation_eval;
  725 
  726   sub split_eqn {
  727     my $instring = shift;
  728 
  729      split /=/, $instring;
  730   }
  731 
  732 
  733   sub equation_cmp {
  734     my $right_ans = shift;
  735     my %opts = @_;
  736     my $vars = ['x','y'];
  737 
  738 
  739     $vars = $opts{'vars'} if defined($opts{'vars'});
  740 
  741     my $ans_eval = sub {
  742       my $student = shift;
  743 
  744       my $ans_hash = new AnswerHash(
  745                                     'score'=>0,
  746                                     'correct_ans'=>$right_ans,
  747                                     'student_ans'=>$student,
  748                                     'original_student_ans' => $student,
  749                                     # 'type' => undef,
  750                                     'ans_message'=>'',
  751                                     'preview_text_string'=>'',
  752                                     'preview_latex_string'=>'',
  753                                    );
  754 
  755       if(! ($student =~ /\S/)) { return $ans_hash; }
  756 
  757       my @right= split_eqn($right_ans);
  758       if(scalar(@right) != 2) {
  759         $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
  760         return $ans_hash;
  761       }
  762       my @studsplit = split_eqn($student);
  763       if(scalar(@studsplit) != 2) {
  764         $ans_hash->{'ans_message'} = "You did not enter an equation (with an equals sign and two sides).";
  765         return $ans_hash;
  766       }
  767 
  768       # Next we should do syntax checks on everyone
  769 
  770       my $ah = new AnswerHash;
  771       $ah->input($right[0]);
  772       $ah=main::check_syntax($ah);
  773       if($ah->{error_flag}) {
  774         $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
  775         return $ans_hash;
  776       }
  777 
  778       $ah->input($right[1]);
  779       $ah=main::check_syntax($ah);
  780       if($ah->{error_flag}) {
  781         $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
  782         return $ans_hash;
  783       }
  784 
  785       # Correct answer checks out, now check student's syntax
  786 
  787       my @prevs = ("","");
  788       my @prevtxt = ("","");
  789       $ah->input($studsplit[0]);
  790       $ah=main::check_syntax($ah);
  791       if($ah->{error_flag}) {
  792         $ans_hash->{'ans_message'} = "Syntax error on the left side of your equation.";
  793         return $ans_hash;
  794       }
  795       $prevs[0] = $ah->{'preview_latex_string'};
  796       $prevstxt[0] = $ah->{'preview_text_string'};
  797 
  798 
  799       $ah->input($studsplit[1]);
  800       $ah=main::check_syntax($ah);
  801       if($ah->{error_flag}) {
  802         $ans_hash->{'ans_message'} = "Syntax error on the right side of your equation.";
  803         return $ans_hash;
  804       }
  805       $prevs[1] = $ah->{'preview_latex_string'};
  806       $prevstxt[1] = $ah->{'preview_text_string'};
  807 
  808       $ans_hash->{'preview_latex_string'} = "$prevs[0] = $prevs[1]";
  809       $ans_hash->{'preview_text_string'} = "$prevstxt[0] = $prevstxt[1]";
  810 
  811 
  812       # Check for answer equivalent to 0=0
  813       # Could be false positive below because of parameter
  814       my $ae = main::fun_cmp("0", %opts);
  815       my $res = $ae->evaluate("$studsplit[0]-($studsplit[1])");
  816       if($res->{'score'}==1) {
  817         # Student is 0=0, is correct answer also like this?
  818         $res = $ae->evaluate("$right[0]-($right[1])");
  819         if($res->{'score'}==1) {
  820           $ans_hash-> setKeys('score' => $res->{'score'});
  821         }
  822         return $ans_hash;
  823       }
  824 
  825       # Maybe answer really is 0=0, and student got it wrong, so check that
  826       $res = $ae->evaluate("$right[0]-($right[1])");
  827       if($res->{'score'}==1) {
  828         return $ans_hash;
  829       }
  830 
  831       # Finally, use fun_cmp to check the answers
  832 
  833       $ae = main::fun_cmp("o*($right[0]-($right[1]))", vars=>$vars, params=>['o'], %opts);
  834       $res= $ae->evaluate("$studsplit[0]-($studsplit[1])");
  835       $ans_hash-> setKeys('score' => $res->{'score'});
  836 
  837       return $ans_hash;
  838     };
  839 
  840     return $ans_eval;
  841   }
  842 }
  843 
  844 =head3 interval_cmp ()
  845 
  846 Compares an interval or union of intervals.  Typical invocations are
  847 
  848   interval_cmp("(2, 3] U(7, 11)")
  849 
  850 The U is used for union symbol.  In fact, any garbage (or nothing at all)
  851 can go between intervals.  It makes sure open/closed parts of intervals
  852 are correct, unless you don't like that.  To have it ignore the difference
  853 between open and closed endpoints, use
  854 
  855   interval_cmp("(2, 3] U(7, 11)", sloppy=>'yes')
  856 
  857 interval_cmp uses num_cmp on the endpoints.  You can pass optional
  858 arguments for num_cmp, so to change the tolerance, you can use
  859 
  860   interval_cmp("(2, 3] U(3+4, 11)", relTol=>3)
  861 
  862 The intervals can be listed in any order, unless you want to force a
  863 particular order, which is signaled as
  864 
  865   interval_cmp("(2, 3] U(3+4, 11)", ordered=>'strict')
  866 
  867 You can specify infinity as an endpoint.  It will do a case-insensitive
  868 string match looking for I, Infinity, Infty, or Inf.  You can prepend a +
  869 or -, as in
  870 
  871   interval_cmp("(-inf, 3] U [e^10, infinity)")
  872 or
  873   interval_cmp("(-INF, 3] U [e^10, +I)")
  874 
  875 If the question might have an empty set as the answer, you can use
  876 the strings option to allow for it.  So
  877 
  878   interval_cmp("$ans", strings=>['empty'])
  879 
  880 will not generate an error message if the student enters the string
  881 empty.  Better still, it will mark a student answer of "empty" as correct
  882 iff this matches $ans.
  883 
  884 You can use interval_cmp for ordered pairs, or lists of ordered pairs.
  885 Internally, this is just a distinction of whether to put nice union symbols
  886 between intervals, or commas.  To get commas, use
  887 
  888   interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no')
  889 
  890 Note that interval_cmp makes no attempt at simplifying overlapping intervals.
  891 This becomes an important feature when you are really checking lists of
  892 ordered pairs.
  893 
  894 =cut
  895 
  896 sub interval_cmp {
  897   Interval_evaluator::interval_cmp(@_);
  898 }
  899 
  900 =head3 number_list_cmp ()
  901 
  902 Checks an answer which is a comma-separated list of numbers.  The actual
  903 numbers are fed to num_cmp, so all of the flexibilty of num_cmp carries
  904 over (values can be expressions to be evaluated).  For example,
  905 
  906   number_list_cmp("1, -2")
  907 
  908 will accept "1, -2", "-2, 1", or "-1-1,sqrt(1)".
  909 
  910   number_list_cmp("1^2 + 1, 2^2 + 1, 3^2 + 1", ordered=>'strict')
  911 
  912 will accept "2, 5, 10", but not "5, 2, 10".
  913 
  914 If you want to allow complex number entries, complex=>'ok' will cause it
  915 to use cplx_cmp instead:
  916 
  917   number_list_cmp("2, -2, 2i, -2i", complex=>'ok')
  918 
  919 In cases where you set complex=>'ok', be sure the problem file loads
  920 PGcomplexmacros.pl.
  921 
  922 Optional arguements for num_cmp (resp. cplx_cmp) can be used as well,
  923 such as
  924 
  925   number_list_cmp("cos(3), sqrt(111)", relTol => 3)
  926 
  927 The strings=>['hello'] argument is treated specially.  It can be used to
  928 replace the entire answer.  So
  929 
  930   number_list_cmp("cos(3), sqrt(111)", strings=>['none'])
  931 
  932 will mark "none" wrong, but not generate an error.  On the other hand,
  933 
  934   number_list_cmp("none", strings=>['none'])
  935 
  936 will makr "none" as correct.
  937 
  938 =cut
  939 
  940 sub number_list_cmp {
  941   Number_List::number_list_cmp(@_);
  942 }
  943 
  944 =head3 equation_cmp ()
  945 
  946 Compares an equation.  This really piggy-backs off of fun_cmp.  It looks
  947 at LHS-RHS of the equations to see if they agree up to constant multiple.
  948 It also guards against an answer of 0=0 (which technically gives a constant
  949 multiple of any equation).  It is best suited to situations such as checking
  950 the equation of a line which might be vertical and you don't want to give
  951 that away, or checking equations of ellipses where the students answer should
  952 be quadratic.
  953 
  954 Typical invocation would be:
  955 
  956   equation_com("x^2+(y-1)^2 = 11", vars=>['x','y'])
  957 
  958 =cut
  959 
  960 sub equation_cmp {
  961   Equation_eval::equation_cmp(@_);
  962 }
  963 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9