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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1080 - (download) (as text) (annotate)
Mon Jun 9 17:49:36 2003 UTC (16 years, 8 months ago) by apizer
File size: 13925 byte(s)
remove unneccsary shebang lines

Arnie

    1 
    2 
    3 # Answer evaluator which always marks things correct
    4 sub auto_right {
    5   my $ae = std_str_cmp("");
    6 
    7   my $ans_eval = sub {
    8     my $tried = shift;
    9     my $ans_hash = &$ae($tried);
   10     $ans_hash->{score} = 1;
   11     return $ans_hash;
   12   };
   13   return $ans_eval;
   14 }
   15 
   16 # Evaluate in tth mode
   17 
   18 sub tthev {
   19   my $cmt = shift;
   20 
   21   $mdm = $main::displayMode;
   22   $main::displayMode = 'HTML_tth';
   23   $cmt = EV3($cmt);
   24   $cmt =~ s/\\par/<P>/g;
   25         $cmt =~ s/\\noindent//g;
   26   $main::displayMode =$mdm;
   27   $cmt
   28 }
   29 
   30 sub no_decs {
   31   my ($old_evaluator) = @_;
   32 
   33   my $msg= "Your answer contains a decimal.  You must provide an exact answer, e.g. sqrt(5)/3";
   34   $old_evaluator->install_pre_filter(must_have_filter(".", 'no', $msg));
   35   $old_evaluator->install_post_filter(\&raw_student_answer_filter);
   36 
   37   return $old_evaluator;
   38   }
   39 
   40 sub must_include {
   41   my ($old_evaluator) = shift;
   42   my $muststr = shift;
   43 
   44   $old_evaluator->install_pre_filter(must_have_filter($muststr));
   45   $old_evaluator->install_post_filter(\&raw_student_answer_filter);
   46   return $old_evaluator;
   47   }
   48 
   49 sub no_trig_fun {
   50   my ($ans) = shift;
   51   my $new_eval = fun_cmp($ans);
   52   my ($msg) = "Your answer to this problem may not contain a trig function.";
   53   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
   54   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
   55   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
   56   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
   57   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
   58   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
   59 
   60   return $new_eval;
   61 }
   62 
   63 
   64 sub no_trig {
   65   my ($ans) = shift;
   66   my $new_eval = num_cmp($ans);
   67   my ($msg) = "Your answer to this problem may not contain a trig function.";
   68   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
   69   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
   70   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
   71   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
   72   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
   73   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
   74 
   75   return $new_eval;
   76 }
   77 
   78 sub exact_no_trig {
   79   my ($ans) = shift;
   80   my $old_eval = num_cmp($ans);
   81   my $new_eval = no_decs($old_eval);
   82   my ($msg) = "Your answer to this problem may not contain a trig function.";
   83   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
   84   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
   85   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
   86   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
   87   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
   88   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
   89 
   90   return $new_eval;
   91 }
   92 
   93 # First argument is the string to have, or not have
   94 # Second argument is optional, and tells us whether yes or no
   95 # Third argument is the error message to produce (if any).
   96 sub must_have_filter {
   97   my $str = shift;
   98   my $yesno = shift;
   99   my $errm = shift;
  100 
  101   $str =~ s/\./\\./g;
  102   if(!defined($yesno)) {
  103     $yesno=1;
  104   } else {
  105     $yesno = ($yesno eq 'no') ? 0 :1;
  106   }
  107 
  108   my $newfilt = sub {
  109     my $num = shift;
  110     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  111     my ($rh_ans);
  112     if ($process_ans_hash) {
  113       $rh_ans = $num;
  114       $num = $rh_ans->{original_student_ans};
  115     }
  116     my $is_ok = 0;
  117 
  118     return $is_ok unless defined($num);
  119 
  120     if (($yesno and ($num =~ /$str/)) or (!($yesno) and !($num=~ /$str/))) {
  121       $is_ok = 1;
  122     }
  123 
  124     if ($process_ans_hash)   {
  125       if ($is_ok == 1 ) {
  126         $rh_ans->{original_student_ans}=$num;
  127         return $rh_ans;
  128       } else {
  129         if(defined($errm)) {
  130           $rh_ans->{ans_message} = $errm;
  131           $rh_ans->{student_ans} = $rh_ans->{original_student_ans};
  132 #         $rh_ans->{student_ans} = "Your answer was \"$rh_ans->{original_student_ans}\". $errm";
  133           $rh_ans->throw_error('SYNTAX', $errm);
  134         } else {
  135           $rh_ans->throw_error('NUMBER', "");
  136         }
  137         return $rh_ans;
  138       }
  139 
  140     } else {
  141       return $is_ok;
  142     }
  143   };
  144   return $newfilt;
  145 }
  146 
  147 sub raw_student_answer_filter {
  148   my ($rh_ans) = shift;
  149 # warn "answer was ".$rh_ans->{student_ans};
  150   $rh_ans->{student_ans} = $rh_ans->{original_student_ans}
  151     unless ($rh_ans->{student_ans} =~ /[a-zA-Z]/);
  152 # warn "2nd time ... answer was ".$rh_ans->{student_ans};
  153 
  154   return $rh_ans;
  155 }
  156 
  157 sub no_decimal_list {
  158   my ($ans) = shift;
  159   my (%jopts) = @_;
  160   my $old_evaluator = number_list_cmp($ans);
  161 
  162   my $answer_evaluator = sub {
  163     my $tried = shift;
  164     my $ans_hash;
  165       if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  166         $ans_hash = $old_evaluator->evaluate($tried);
  167       } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  168         $ans_hash = &$old_evaluator($tried);
  169     }
  170     if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) {
  171       $ans_hash->{score}=0;
  172       $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.');
  173     }
  174     if($tried =~ /\./) {
  175       $ans_hash->{score}=0;
  176       $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.');
  177     }
  178     return $ans_hash;
  179   };
  180   return $answer_evaluator;
  181 }
  182 
  183 
  184 sub no_decimals {
  185   my ($ans) = shift;
  186   my (%jopts) = @_;
  187   my $old_evaluator = std_num_cmp($ans);
  188 
  189   my $answer_evaluator = sub {
  190     my $tried = shift;
  191     my $ans_hash;
  192       if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  193         $ans_hash = $old_evaluator->evaluate($tried);
  194       } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  195         $ans_hash = &$old_evaluator($tried);
  196     }
  197     if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) {
  198       $ans_hash->{score}=0;
  199       $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.');
  200     }
  201     if($tried =~ /\./) {
  202       $ans_hash->{score}=0;
  203       $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.');
  204     }
  205     return $ans_hash;
  206   };
  207   return $answer_evaluator;
  208 }
  209 
  210 sub log_switcheroo {
  211   my $foo = shift;
  212 
  213   $foo =~ s/log(?!ten)/logten/gi;
  214   return $foo;
  215 }
  216 
  217 # only used below, so assumes it is being applied to num_cmp
  218 sub log_switcheroo_filter {
  219   my ($rh_ans) = shift;
  220   $rh_ans->{student_ans} = log_switcheroo($rh_ans->{student_ans});
  221 
  222   return $rh_ans;
  223   }
  224 
  225 sub log10_cmp {
  226  my(@stuff) = @_;
  227  $stuff[0] = log_switcheroo($stuff[0]);
  228  my ($ae) = num_cmp(@stuff);
  229  $ae->install_pre_filter(\&log_switcheroo_filter);
  230  return $ae;
  231 }
  232 
  233 # Wrapper for an answer evaluator which can also supply comments
  234 sub with_comments {
  235   my ($old_evaluator, $cmt) = @_;
  236 
  237 #   $mdm = $main::displayMode;
  238 #   $main::displayMode = 'HTML_tth';
  239 #   $cmt = EV2($cmt);
  240 #   $main::displayMode =$mdm;
  241 
  242   my $ans_evaluator =  sub  {
  243     my $tried = shift;
  244     my $ans_hash;
  245 
  246     if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  247       $ans_hash = $old_evaluator->evaluate($tried);
  248     } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  249       $ans_hash = &$old_evaluator($tried);
  250     } else {
  251       warn "There is a problem using the answer evaluator";
  252     }
  253 
  254     if($ans_hash->{score}>0) {
  255       $ans_hash -> setKeys( 'ans_message' => $cmt);
  256     }
  257     return $ans_hash;
  258   };
  259 
  260   $ans_evaluator;
  261 }
  262 
  263 # Wrapper for multiple answer evaluators, it takes a list of the following as inputs
  264 # [answer_evaluator, partial credit factor, comment]
  265 # it applies evaluators from the list until it hits one with positive credit,
  266 # weights it by the partial credit factor, and throws in its comment
  267 
  268 sub pc_evaluator {
  269   my ($evaluator_list) = @_;
  270 
  271   my $ans_evaluator =  sub  {
  272     my $tried = shift;
  273     my $ans_hash;
  274     for($j=0;$j<scalar(@{$evaluator_list}); $j++) {
  275       my $old_evaluator = $evaluator_list->[$j][0];
  276       my $cmt = $evaluator_list->[$j][2];
  277       my $weight = $evaluator_list->[$j][1];
  278 
  279       if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  280         $ans_hash = $old_evaluator->evaluate($tried);
  281       } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  282         $ans_hash = &$old_evaluator($tried);
  283       } else {
  284         warn "There is a problem using the answer evaluator";
  285       }
  286 
  287       if($ans_hash->{score}>0) {
  288         $ans_hash -> setKeys( 'ans_message' => $cmt);
  289         $ans_hash->{score} *= $weight;
  290         return $ans_hash;
  291       };
  292     };
  293     return $ans_hash;
  294   };
  295 
  296   $ans_evaluator;
  297 }
  298 
  299 sub nicestring {
  300   my($thingy) = shift;
  301   my(@coefs) = @{$thingy};
  302   my $n = scalar(@coefs);
  303   $thingy = shift;
  304   my(@others);
  305   if(defined($thingy)) {
  306     @others = @{$thingy};
  307   } else {
  308     my($j);
  309     for $j (1..($n-2)) {
  310       $others[$j-1] = "x^".($n-$j);
  311     }
  312     if($n>=2) { $others[$n-2] = "x";}
  313     $others[$n-1] = "";
  314   }
  315   my($j, $k)=(0,0);
  316   while(($k<$n) && ($coefs[$k]==0)) {$k++;}
  317   if($k==$n) {return("0");}
  318   my $ans;
  319   if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";}
  320   elsif($coefs[$k]== -1) {$ans =  ($others[$k]) ? "- $others[$k]" : "-1"}
  321   else { $ans = "$coefs[$k] $others[$k]";}
  322   $k++;
  323   for $j ($k..($n-1)) {
  324     if($coefs[$j] != 0) {
  325       if($coefs[$j] == 1) {
  326         $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1";
  327       } elsif($coefs[$j] == -1) {
  328         $ans .= ($others[$j]) ? "- $others[$j]" : "-1";
  329       } else {
  330         $ans .= "+ $coefs[$j] $others[$j]";
  331       }
  332     }
  333   }
  334   return($ans);
  335 }
  336 
  337 
  338 sub displaymat {
  339   my $tmpp = shift;
  340   my %opts = @_;
  341   my @myrows = @{$tmpp};
  342   my $numrows = scalar(@myrows);
  343   my @arow = $myrows->[0];
  344   my ($number)= scalar(@arow);   #number of columns in table
  345   my $out;
  346   my $j;
  347   my $align1=''; # alignment as a string
  348   my @align;     # alignment as a list
  349   if(defined($opts{'align'})) {
  350     $align1= $opts{'align'};
  351     @align = split //, $opts{'align'};
  352   } else {
  353     for($j=0; $j<$number; $j++) {
  354       $align[$j] = "c";
  355       $align1 .= "c";
  356     }
  357   }
  358 
  359   $out .= beginmatrix($align1);
  360   $out .= matleft($numrows);
  361   for $j (@myrows) {
  362     $out .= matrow($j, @align);
  363   }
  364   $out .= matright($numrows);
  365   $out .= endmatrix();
  366   $out;
  367 }
  368 
  369 sub beginmatrix {
  370   my ($aligns)=shift;   #alignments of columns in table
  371 # my %options = @_;
  372   my $out = "";
  373   if ($displayMode eq 'TeX') {
  374     $out .= "\n\\(\\displaystyle\\left(\\begin{array}{$aligns} \n";
  375     }
  376   elsif ($displayMode eq 'Latex2HTML') {
  377     $out .= "\n\\begin{rawhtml} <TABLE  BORDER=0>\n\\end{rawhtml}";
  378     }
  379   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng') {
  380     $out .= "<TABLE BORDER=0>\n"
  381   }
  382   else {
  383     $out = "Error: beginmatrix: Unknown displayMode: $displayMode.\n";
  384     }
  385   $out;
  386 }
  387 
  388 
  389 sub matleft {
  390   my $numrows = shift;
  391   if ($displayMode eq 'TeX') {
  392     return "";
  393   }
  394   my $out='';
  395   my $j;
  396 
  397   if(($displayMode eq 'HTML_dpng') || ($displayMode eq 'Latex2HTML')) {
  398 #     if($numrows>12) {   $numrows = 12; }
  399     if($displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; }
  400     $out .= "<tr><td nowrap=\"nowrap\" align=\"left\">";
  401     if($displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; }
  402 #     $out .= "<img alt=\"(\" src = \"".
  403 #       $main::imagesURL."/left$numrows.png\" >";
  404 #     return $out;
  405     $out .= '\(\left.\begin{array}{c}';
  406     for($j=0;$j<$numrows;$j++)  { $out .= ' \\\\'; }
  407     $out .= '\end{array}\right(\)';
  408 
  409     if($displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; }
  410     $out .= "<td><table border=0  cellspacing=5>\n";
  411     if($displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; }
  412     return $out;
  413   }
  414   $out = "<tr><td nowrap=\"nowrap\" align=\"left\"><font face=\"symbol\"><br />";
  415   for($j=0;$j<$numrows;$j++)  {
  416     $out .= "<br />";
  417   }
  418   $out .= "</font></td>\n";
  419   $out .= "<td><table border=0  cellspacing=5>\n";
  420   return $out;
  421 }
  422 
  423 sub matright {
  424   my $numrows = shift;
  425   my $out='';
  426   my $j;
  427 
  428   if ($displayMode eq 'TeX') {
  429     return "";
  430   }
  431 
  432   if(($displayMode eq 'HTML_dpng') || ($displayMode eq 'Latex2HTML')) {
  433     if($displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; }
  434     $out .= "</table><td nowrap=\"nowrap\" align=\"right\">";
  435     if($displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; }
  436 
  437 #   $out .= "<img alt=\"(\" src = \"".
  438 #     "/webwork_system_html/images"."/right$numrows.png\" >";
  439     $out .= '\(\left)\begin{array}{c}';
  440     for($j=0;$j<$numrows;$j++)  { $out .= ' \\\\'; }
  441     $out .= '\end{array}\right.\)';
  442     return $out;
  443   }
  444 
  445   $out .= "</table>";
  446   $out .= "<td nowrap=\"nowrap\" align=\"left\"><font face=\"symbol\"><br />";
  447   for($j=0;$j<$numrows;$j++)  {
  448     $out .= "<br />";
  449   }
  450   $out .= "</font></td>\n";
  451   return $out;
  452 }
  453 
  454 sub endmatrix {
  455   my $out = "";
  456   if ($displayMode eq 'TeX') {
  457     $out .= "\n\\end{array}\\right)\\)\n";
  458     }
  459   elsif ($displayMode eq 'Latex2HTML') {
  460     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
  461     }
  462   elsif ($displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng') {
  463     $out .= "</TABLE>\n";
  464     }
  465   else {
  466     $out = "Error: PGchoicemacros: endtable: Unknown displayMode: $displayMode.\n";
  467     }
  468   $out;
  469 }
  470 
  471 
  472 sub matrow {
  473   my $elements = shift;
  474   my @align = @_;
  475   my @elements = @{$elements};
  476   my $out = "";
  477   if ($displayMode eq 'TeX') {
  478     while (@elements) {
  479       $out .= shift(@elements) . " &";
  480       }
  481      chop($out); # remove last &
  482      $out .= "\\\\  \n";
  483      # carriage returns must be added manually for tex
  484     }
  485   elsif ($displayMode eq 'Latex2HTML') {
  486     $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n";
  487     while (@elements) {
  488       $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n";
  489       }
  490     $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n";
  491   }
  492   elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $displayMode eq 'HTML_dpng') {
  493     $out .= "<TR><td nowrap=\"nowrap\">\n";
  494     while (@elements) {
  495       my $myalign;
  496       #do {$myalign = shift @align;} until($myalign ne "|");
  497       $myalign = shift @align;
  498       if($myalign eq "|") {
  499         $out .= '<td> | </td>';
  500       } else {
  501         if($myalign eq "c") { $myalign = "center";}
  502         if($myalign eq "l") { $myalign = "left";}
  503         if($myalign eq "r") { $myalign = "right";}
  504         $out .= "<TD nowrap=\"nowrap\" align=\"$myalign\">" . shift(@elements) . "</TD>";
  505       }
  506       }
  507     $out .= "<td>\n</TR>\n";
  508   }
  509   else {
  510     $out = "Error: matrow: Unknown displayMode: $main::displayMode.\n";
  511     }
  512   $out;
  513 }
  514 
  515 
  516 ## Local Variables:
  517 ## mode: CPerl
  518 ## font-lock-mode: t
  519 ## End:

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9