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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1080 - (view) (download) (as text)

1 : gage 1064
2 : apizer 1080
3 : gage 1064 # Answer evaluator which always marks things correct
4 :     sub auto_right {
5 :     my $ae = std_str_cmp("");
6 : apizer 1080
7 : gage 1064 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 : apizer 1080
21 : gage 1064 $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 : apizer 1080
118 : gage 1064 return $is_ok unless defined($num);
119 : apizer 1080
120 : gage 1064 if (($yesno and ($num =~ /$str/)) or (!($yesno) and !($num=~ /$str/))) {
121 :     $is_ok = 1;
122 :     }
123 : apizer 1080
124 : gage 1064 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 : apizer 1080
140 : gage 1064 } 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 : apizer 1080 # warn "2nd time ... answer was ".$rh_ans->{student_ans};
153 :    
154 : gage 1064 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 : apizer 1080
237 : gage 1064 # $mdm = $main::displayMode;
238 :     # $main::displayMode = 'HTML_tth';
239 :     # $cmt = EV2($cmt);
240 :     # $main::displayMode =$mdm;
241 : apizer 1080
242 : gage 1064 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 : apizer 1080
254 : gage 1064 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 : apizer 1080
271 : gage 1064 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 : apizer 1080
287 : gage 1064 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 : apizer 1080
296 : gage 1064 $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 : apizer 1080 else {
383 : gage 1064 $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 : apizer 1080
409 : gage 1064 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 : apizer 1080
428 : gage 1064 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 : apizer 1080
437 : gage 1064 # $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