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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : lr003k 1123 #!/usr/local/bin/webwork-perl
2 : gage 1064
3 :     BEGIN{
4 :     be_strict();
5 :     }
6 :    
7 :     sub _PGmorematrixmacros_init{}
8 :    
9 :     sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix.
10 :    
11 :     warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)"
12 :     if (@_ != 2);
13 :     my $A = new Matrix($_[0],$_[1]);
14 :     my $A_lr = new Matrix($_[0],$_[1]);
15 :     my $det = 0;
16 :     my $safety=0;
17 :     while ($det == 0 and $safety < 6) {
18 :     foreach my $i (1..$_[0]) {
19 :     foreach my $j (1..$_[1]) {
20 :     $A->assign($i,$j,random(-9,9,1) );
21 :     }
22 :     }
23 :     $A_lr = $A->decompose_LR();
24 :     $det = $A_lr->det_LR();
25 :     }
26 :     return $A;
27 :     }
28 :    
29 : lr003k 1327 =head4 random_diag_matrix
30 :    
31 :     This method returns a random nxn diagonal matrix.
32 :    
33 :     =cut
34 :    
35 :     sub random_diag_matrix{ ## Builds and returns a random diagonal \$n by \$n matrix
36 :    
37 :     warn "Usage: \$new_matrix = random_diag_matrix(\$n)" if (@_ != 1);
38 :    
39 :     my $D = new Matrix($_[0],$_[0]);
40 :     my $norm = 0;
41 :     while( $norm == 0 ){
42 :     foreach my $i (1..$_[0]){
43 :     foreach my $j (1..$_[0]){
44 :     if( $i != $j ){
45 :     $D->assign($i,$j,0);
46 :     }else{
47 :     $D->assign($i,$j,random(-9,9,1));
48 :     }
49 :     }
50 :     }
51 :     $norm = abs($D);
52 :     }
53 :     return $D;
54 :     }
55 :    
56 : gage 1064 sub swap_rows{
57 :    
58 :     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
59 :     if (@_ != 3);
60 :     my $matrix = $_[0];
61 :     my ($i,$j) = ($_[1],$_[2]);
62 :     warn "Error: Rows to be swapped must exist!"
63 :     if ($i>@$matrix or $j >@$matrix);
64 :     warn "Warning: Swapping the same row is pointless"
65 :     if ($i==$j);
66 :     my $cols = @{$matrix->[0]};
67 :     my $B = new Matrix(@$matrix,$cols);
68 :     foreach my $k (1..$cols){
69 :     $B->assign($i,$k,element $matrix($j,$k));
70 :     $B->assign($j,$k,element $matrix($i,$k));
71 :     }
72 :     return $B;
73 :     }
74 :    
75 :     sub row_mult{
76 :    
77 :     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
78 :     if (@_ != 3);
79 :     my $matrix = $_[0];
80 :     my ($scalar,$row) = ($_[1],$_[2]);
81 :     warn "Undefined row multiplication"
82 :     if ($row > @$matrix);
83 :     my $B = new Matrix(@$matrix,@{$matrix->[0]});
84 :     foreach my $j (1..@{$matrix->[0]}) {
85 :     $B->assign($row,$j,$scalar*element $matrix($row,$j));
86 :     }
87 :     return $B;
88 :     }
89 :    
90 :     sub linear_combo{
91 :    
92 :     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
93 :     if (@_ != 4);
94 :     my $matrix = $_[0];
95 :     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
96 :     warn "Undefined row in multiplication"
97 :     if ($row1>@$matrix or $row2>@$matrix);
98 :     warn "Warning: Using the same row"
99 :     if ($row1==$row2);
100 :     my $B = new Matrix(@$matrix,@{$matrix->[0]});
101 :     foreach my $j (1..@$matrix) {
102 :     my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
103 :     $B->assign($row2,$j,$scalar*$t1+$t2);
104 :     }
105 :     return $B;
106 :     }
107 :    
108 : gage 1071 =head3 basis_cmp()
109 : gage 1064
110 : gage 1071 Compares a list of vectors by finding the change of coordinate matrix
111 :     from the Prof's vectors to the students, and then taking the determinant of
112 :     that to determine the existence of the change of coordinate matrix going the
113 :     other way.
114 :    
115 :     ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
116 :    
117 :     1. a reference to an array of correct vectors
118 :     2. a hash with the following keys (all optional):
119 :     mode -- 'basis' (default) (only a basis allowed)
120 :     'orthogonal' (only an orthogonal basis is allowed)
121 :     'unit' (only unit vectors in the basis allowed)
122 :     'orthonormal' (only orthogonal unit vectors in basis allowed)
123 :     zeroLevelTol -- absolute tolerance to allow when answer is close
124 :     to zero
125 :    
126 :     debug -- if set to 1, provides verbose listing of
127 :     hash entries throughout fliters.
128 :    
129 :     help -- 'none' (default) (is quiet on all errors)
130 :     'dim' (Tells student if wrong number of vectors are entered)
131 :     'length' (Tells student if there is a vector of the wrong length)
132 :     'orthogonal' (Tells student if their vectors are not orthogonal)
133 :     (This is only in orthogonal mode)
134 :     'unit' (Tells student if there is a vector not of unit length)
135 :     (This is only in unit mode)
136 :     'orthonormal' (Gives errors from orthogonal and orthonormal)
137 :     (This is only in orthonormal mode)
138 :     'verbose' (Gives all the above answer messages)
139 :    
140 :     Returns an answer evaluator.
141 :    
142 :     EXAMPLES:
143 :    
144 :     basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
145 :     -- correct answer is any basis for R^3.
146 :     basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
147 :     -- correct answer is any orthonormal basis
148 :     for this space such as:
149 :     [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
150 :    
151 :     =cut
152 :    
153 :    
154 :     sub basis_cmp {
155 :     my $correctAnswer = shift;
156 :     my %opt = @_;
157 :    
158 :     set_default_options( \%opt,
159 :     'zeroLevelTol' => $main::functZeroLevelTolDefault,
160 :     'debug' => 0,
161 :     'mode' => 'basis',
162 :     'help' => 'none',
163 :     );
164 :    
165 :     # produce answer evaluator
166 :     BASIS_CMP(
167 :     'correct_ans' => $correctAnswer,
168 :     'zeroLevelTol' => $opt{'zeroLevelTol'},
169 :     'debug' => $opt{'debug'},
170 :     'mode' => $opt{'mode'},
171 :     'help' => $opt{'help'},
172 :     );
173 :     }
174 :    
175 :     =head BASIS_CMP
176 :    
177 :     Made to keep the same format as num_cmp and fun_cmp.
178 :    
179 :     =cut
180 :    
181 :     sub BASIS_CMP {
182 :     my %mat_params = @_;
183 :     my $zeroLevelTol = $mat_params{'zeroLevelTol'};
184 :    
185 :     # Check that everything is defined:
186 :     $mat_params{debug} = 0 unless defined($mat_params{debug});
187 :     $zeroLevelTol = $main::functZeroLevelTolDefault unless defined $zeroLevelTol;
188 :     $mat_params{'zeroLevelTol'} = $zeroLevelTol;
189 :    
190 :     ## This is where the correct answer should be checked someday.
191 :     my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
192 :    
193 :     #construct the answer evaluator
194 :     my $answer_evaluator = new AnswerEvaluator;
195 :    
196 :     $answer_evaluator->{debug} = $mat_params{debug};
197 : lr003k 1278 $answer_evaluator->ans_hash( correct_ans => display_correct_vecs($mat_params{correct_ans}),
198 : gage 1071 rm_correct_ans => $matrix,
199 :     zeroLevelTol => $mat_params{zeroLevelTol},
200 :     debug => $mat_params{debug},
201 :     mode => $mat_params{mode},
202 :     help => $mat_params{help},
203 :     );
204 :    
205 :     $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
206 :     $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace
207 :     $rh_ans;
208 :     });
209 : lr003k 1123 $answer_evaluator->install_pre_filter(sub{my $rh_ans = shift; my @options = @_;
210 :     if( $rh_ans->{ans_label} =~ /ArRaY/ ){
211 :     $rh_ans = ans_array_filter($rh_ans,@options);
212 :     my @student_array = @{$rh_ans->{ra_student_ans}};
213 :     my @array = ();
214 :     for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
215 :     {
216 :     push( @array, Matrix->new_from_array_ref($student_array[$i]));
217 :     }
218 :     $rh_ans->{ra_student_ans} = \@array;
219 :     $rh_ans;
220 :     }else{
221 : lr003k 1265 $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
222 : lr003k 1123 vec_list_string($rh_ans,@options);
223 :     }
224 :    
225 :     });#ra_student_ans is now the students answer as an array of vectors
226 : gage 1071 # anonymous subroutine to check dimension and length of the student vectors
227 :     # if either is wrong, the answer is wrong.
228 :     $answer_evaluator->install_pre_filter(sub{
229 :     my $rh_ans = shift;
230 :     my $length = $rh_ans->{rm_correct_ans}->[1];
231 :     my $dim = $rh_ans->{rm_correct_ans}->[2];
232 :     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
233 :     {
234 :    
235 :     $rh_ans->{score} = 0;
236 :     if( $rh_ans->{help} =~ /dim|verbose/ )
237 :     {
238 :     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
239 :     }else{
240 :     $rh_ans->throw_error('EVAL');
241 :     }
242 :     }
243 :     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
244 :     {
245 :     if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
246 :     {
247 :     $rh_ans->{score} = 0;
248 :     if( $rh_ans->{help} =~ /length|verbose/ )
249 :     {
250 :     $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
251 :     }else{
252 :     $rh_ans->throw_error('EVAL');
253 :     }
254 :     }
255 :     }
256 :     $rh_ans;
257 :     });
258 :     # Install prefilter for various modes
259 :     if( $mat_params{mode} ne 'basis' )
260 :     {
261 :     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
262 :     {
263 : lr003k 1265 $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
264 : gage 1071 }
265 :    
266 :     if( $mat_params{mode} =~ /unit|orthonormal/ )
267 :     {
268 : lr003k 1265 $answer_evaluator->install_pre_filter(\&are_unit_vecs);
269 : gage 1071
270 :     }
271 :     }
272 :     $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
273 :     $answer_evaluator->install_post_filter(
274 :     sub {my $rh_ans = shift;
275 :     if ($rh_ans->catch_error('SYNTAX') ) {
276 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
277 :     $rh_ans->clear_error('SYNTAX');
278 :     }
279 :     if ($rh_ans->catch_error('EVAL') ) {
280 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
281 :     $rh_ans->clear_error('EVAL');
282 :     }
283 :     $rh_ans;
284 :     }
285 :     );
286 :     $answer_evaluator;
287 :     }
288 :    
289 :     =head4 compare_basis
290 :    
291 :     compare_basis( $ans_hash, %options);
292 :    
293 :     {ra_student_ans}, # a reference to the array of students answer vectors
294 :     {rm_correct_ans}, # a reference to the correct answer matrix
295 :     %options
296 :     )
297 :    
298 :     =cut
299 :    
300 :     sub compare_basis {
301 :     my ($rh_ans, %options) = @_;
302 :     my @ch_coord;
303 :     my @vecs = @{$rh_ans->{ra_student_ans}};
304 :    
305 :     # A lot of the follosing code was taken from Matrix::proj_coeff
306 :     # calling this method recursively would be a waste of time since
307 :     # the prof's matrix never changes and solve_LR is an expensive
308 :     # operation. This way it is only done once.
309 :     my $matrix = $rh_ans->{rm_correct_ans};
310 :     my ($dim,$x_vector, $base_matrix);
311 :     my $errors = undef;
312 :     my $lin_space_tr= ~ $matrix;
313 :     $matrix = $lin_space_tr * $matrix;
314 :     my $matrix_lr = $matrix->decompose_LR();
315 :    
316 :     #finds the coefficient vectors for each of the students vectors
317 :     for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
318 :     {
319 :    
320 :     $vecs[$i] = $lin_space_tr*$vecs[$i];
321 :     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
322 :     push( @ch_coord, $x_vector );
323 :     $errors = "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" if $dim; # only print if the dim is not zero.
324 :     }
325 :    
326 :     if( defined($errors))
327 :     {
328 :     $rh_ans->throw_error('EVAL', $errors) ;
329 :     }else{
330 :     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
331 :     #existence of this matrix implies that
332 :     #the all of the students answers are a
333 :     #linear combo of the prof's
334 :     $ch_coord_mat = $ch_coord_mat->decompose_LR();
335 :    
336 : lr003k 1161 if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is
337 : gage 1071 # non-zero, this implies the existence of an inverse
338 :     # which implies all of the prof's vectors are a linear
339 :     # combo of the students vectors, showing containment
340 :     # both ways.
341 :     {
342 :     # I think sometimes if the students space has the same dimension as the profs space it
343 :     # will get projected into the profs space even if it isn't a basis for that space.
344 :     # this just checks that the prof's matrix times the change of coordinate matrix is actually
345 :     #the students matrix
346 :     if( abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) - ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord))) < $options{zeroLevelTol} )
347 :     {
348 :     $rh_ans->{score} = 1;
349 :     }else{
350 :     $rh_ans->{score} = 0;
351 :     }
352 :     }
353 :     else{
354 :     $rh_ans->{score}=0;
355 :     }
356 :     }
357 :     $rh_ans;
358 :    
359 :     }
360 :    
361 :    
362 :     =head 2 vec_list_string
363 :    
364 :     This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
365 :     The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
366 :     Each entry can contain functions and operations and the usual math constants (pi and e).
367 :     The vectors, however can not be added or multiplied or scalar multiplied by the student.
368 :     Most errors are handled well. Any error in an entry is caught by the PG_answer_eval like it is in num_cmp or fun_cmp.
369 :     Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
370 :     but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
371 :     later when the length of the vectors is checked.
372 :     In the end, the method returns an array of Matrix objects.
373 :    
374 :    
375 :     =cut
376 :    
377 :     sub vec_list_string{
378 :     my $rh_ans = shift;
379 :     my %options = @_;
380 :     my $i;
381 :     my $entry = "";
382 :     my $char;
383 :     my @paren_stack;
384 :     my $length = length($rh_ans->{student_ans});
385 :     my @temp;
386 :     my $j = 0;
387 :     my @answers;
388 :     my $paren;
389 :     my $display_ans;
390 :    
391 :     for( $i = 0; $i < $length ; $i++ )
392 :     {
393 :     $char = substr($rh_ans->{student_ans},$i,1);
394 :    
395 :     if( $char =~ /\(|\[|\{/ ){
396 :     push( @paren_stack, $char )
397 :     }
398 :    
399 :     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
400 :     {
401 :     if( $char !~ /,|\)|\]|\}/ ){
402 :     $entry .= $char;
403 :     }else{
404 :     if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
405 :     {
406 :     if( length($entry) == 0 ){
407 :     if( $char !~ /,/ ){
408 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
409 :     }else{
410 :     $rh_ans->{preview_text_string} .= ",";
411 :     $rh_ans->{preview_latex_string} .= ",";
412 :     $display_ans .= ",";
413 :     }
414 :     }else{
415 :    
416 :     # This parser code was origianally taken from PGanswermacros::check_syntax
417 :     # but parts of it needed to be slighty modified for this context
418 :     my $parser = new AlgParserWithImplicitExpand;
419 :     my $ret = $parser -> parse($entry); #for use with loops
420 :    
421 :     if ( ref($ret) ) { ## parsed successfully
422 :     $parser -> tostring();
423 :     $parser -> normalize();
424 :     $entry = $parser -> tostring();
425 :     $rh_ans->{preview_text_string} .= $entry.",";
426 :     $rh_ans->{preview_latex_string} .= $parser -> tolatex().",";
427 :    
428 :     } else { ## error in parsing
429 :    
430 :     $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
431 :     $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
432 :     $rh_ans->{'preview_text_string'} = '',
433 :     $rh_ans->{'preview_latex_string'} = '',
434 :     $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
435 :     }
436 :    
437 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
438 :    
439 :     if ($PG_eval_errors) {
440 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
441 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
442 :     last;
443 :     } else {
444 :     $entry = prfmt($inVal,$options{format});
445 :     $display_ans .= $entry.",";
446 :     push(@temp , $entry);
447 :     }
448 :    
449 :     if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
450 :     {
451 :     pop @paren_stack;
452 :     chop($rh_ans->{preview_text_string});
453 :     chop($rh_ans->{preview_latex_string});
454 :     chop($display_ans);
455 :     $rh_ans->{preview_text_string} .= "]";
456 :     $rh_ans->{preview_latex_string} .= "]";
457 :     $display_ans .= "]";
458 :     if( scalar(@temp) > 0 )
459 :     {
460 :     push( @answers,Matrix->new_from_col_vecs([\@temp]));
461 :     while(scalar(@temp) > 0 ){
462 :     pop @temp;
463 :     }
464 :     }else{
465 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
466 :     }
467 :     }
468 :     }
469 :     $entry = "";
470 :     }else{
471 :     $paren = pop @paren_stack;
472 :     if( scalar(@paren_stack) > 0 ){
473 :     #this uses ASCII to check if the parens match up
474 :     # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
475 :     # ord ] = 93 , ord { = 123 , ord } = 125
476 :     if( (ord($char) - ord($paren) <= 2) ){
477 :     $entry = $entry . $char;
478 :     }else{
479 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
480 :     }
481 :     }
482 :     }
483 :     }
484 :     }else{
485 :     $rh_ans->{preview_text_string} .= "[";
486 :     $rh_ans->{preview_latex_string} .= "[";
487 :     $display_ans .= "[";
488 :     }
489 :     }
490 :     $rh_ans->{ra_student_ans} = \@answers;
491 :     $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
492 :     $rh_ans;
493 :     }
494 :    
495 : lr003k 1294 =head5
496 :     This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
497 :     answer entry methods. Running this filter is necessary to get all the entries out of the answer
498 :     hash. Each entry is evaluated and the resulting number is put in the display for student answer
499 :     as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
500 :     and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
501 :     for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
502 :     string is also created, but this display method becomes confusing when large matrices are used.
503 :     =cut
504 :    
505 :    
506 : lr003k 1123 sub ans_array_filter{
507 :     my $rh_ans = shift;
508 :     my %options = @_;
509 :     $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/;
510 :     my $ans_num = $1;
511 :     my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
512 :     my $key;
513 :     my @array = ();
514 :     my ($i,$j,$k) = (0,0,0);
515 :    
516 :     #the keys aren't in order, so their info has to be put into the array before doing anything with it
517 :     foreach $key (@keys){
518 :     $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
519 :     ($i,$j,$k) = ($1,$2,$3);
520 :     $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
521 :     }
522 :    
523 :     my $display_ans = "";
524 : lr003k 1278
525 : lr003k 1123 for( $i=0; $i < scalar(@array) ; $i ++ )
526 :     {
527 :     $display_ans .= " [";
528 :     $rh_ans->{preview_text_string} .= ' [';
529 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
530 : lr003k 1123 for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
531 :     {
532 :     $display_ans .= " [";
533 :     $rh_ans->{preview_text_string} .= ' [';
534 : lr003k 1278 for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
535 : lr003k 1123 my $entry = $array[$i][$j][$k];
536 : lr003k 1238 $entry = math_constants($entry);
537 : lr003k 1123 # This parser code was origianally taken from PGanswermacros::check_syntax
538 :     # but parts of it needed to be slighty modified for this context
539 :     my $parser = new AlgParserWithImplicitExpand;
540 :     my $ret = $parser -> parse($entry); #for use with loops
541 :    
542 :     if ( ref($ret) ) { ## parsed successfully
543 :     $parser -> tostring();
544 :     $parser -> normalize();
545 :     $entry = $parser -> tostring();
546 :     $rh_ans->{preview_text_string} .= $entry.",";
547 : lr003k 1278 $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
548 : lr003k 1237
549 : lr003k 1123 } else { ## error in parsing
550 :     $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
551 :     $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
552 :     $rh_ans->{'preview_text_string'} = '',
553 :     $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
554 :     }
555 :    
556 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
557 :     if ($PG_eval_errors) {
558 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
559 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
560 :     last;
561 :     } else {
562 :     $entry = prfmt($inVal,$options{format});
563 :     $display_ans .= $entry.",";
564 :     $array[$i][$j][$k] = $entry;
565 :     }
566 :     }
567 :     chop($rh_ans->{preview_text_string});
568 :     chop($display_ans);
569 :     $rh_ans->{preview_text_string} .= '] ,';
570 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\\\\';
571 : lr003k 1123 $display_ans .= '] ,';
572 :    
573 :     }
574 :     chop($rh_ans->{preview_text_string});
575 :     chop($display_ans);
576 :     $rh_ans->{preview_text_string} .= '] ,';
577 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
578 : lr003k 1123 $display_ans .= '] ,';
579 :     }
580 :     chop($rh_ans->{preview_text_string});
581 :     chop($rh_ans->{preview_latex_string});
582 : lr003k 1278 chop($rh_ans->{preview_latex_string});
583 :     chop($rh_ans->{preview_latex_string});
584 : lr003k 1123 chop($display_ans);
585 : lr003k 1278
586 : lr003k 1237 my @temp = ();
587 :     for( $i = 0 ; $i < scalar( @array ); $i++ ){
588 :     push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
589 :     push @temp , "," unless $i == scalar(@array) - 1;
590 :     }
591 :     $rh_ans->{student_ans} = mbox(\@temp);
592 : lr003k 1123 $rh_ans->{ra_student_ans} = \@array;
593 :    
594 :     $rh_ans;
595 :    
596 :     }
597 :    
598 : lr003k 1265
599 :     sub are_orthogonal_vecs{
600 : lr003k 1276 my ($vec_ref , %opts) = @_;
601 : lr003k 1265 my @vecs = ();
602 :     if( ref($vec_ref) eq 'AnswerHash' )
603 :     {
604 :     @vecs = @{$vec_ref->{ra_student_ans}};
605 :     }else{
606 :     @vecs = @{$vec_ref};
607 :     }
608 :     my ($i,$j) = (0,0);
609 :    
610 :     my $num = scalar(@vecs);
611 :     my $length = $vecs[0]->[1];
612 :    
613 :     for( ; $i < $num ; $i ++ )
614 :     {
615 :     for( $j = $i+1; $j < $num ; $j++ )
616 :     {
617 : lr003k 1278 if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault )
618 : lr003k 1265 {
619 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
620 :     $vec_ref->{score} = 0;
621 : lr003k 1276 if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
622 : lr003k 1265 {
623 :     $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
624 :     }else{
625 :     $vec_ref->throw_error('EVAL');
626 :     }
627 :     return $vec_ref;
628 :     }else{
629 :     return 0;
630 :     }
631 :     }
632 :     }
633 :     }
634 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
635 :     $vec_ref->{score} = 1;
636 :     $vec_ref;
637 :     }else{
638 :     1;
639 :     }
640 :     }
641 :    
642 : lr003k 1327 sub is_diagonal{
643 :     my $matrix = shift;
644 :     my %options = @_;
645 :     my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
646 :     my ($rh_ans);
647 :     if ($process_ans_hash) {
648 :     $rh_ans = $matrix;
649 :     $matrix = $rh_ans->{ra_student_ans};
650 :     }
651 :    
652 :     return 0 unless defined($matrix);
653 :    
654 :     if( ref($matrix) eq 'ARRAY' ){
655 :     my @matrix = @{$matrix};
656 :     @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
657 :     if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
658 :     warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
659 :     }
660 :    
661 :     for( my $i = 0; $i < scalar( @matrix ) ; $i++ ){
662 :     for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
663 :     if( $matrix[$i][$j] != 0 and $i != $j )
664 :     {
665 :     if ($process_ans_hash){
666 :     $rh_ans->throw_error('EVAL');
667 :     return $rh_ans;
668 :     } else {
669 :     return 0;
670 :     }
671 :     }
672 :     }
673 :     }
674 :     if ($process_ans_hash){
675 :     return $rh_ans;
676 :     } else {
677 :     return 1;
678 :     }
679 :     }elsif( ref($matrix) eq 'Matrix' ){
680 :     if( $matrix->[1] != $matrix->[2] ){
681 :     warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
682 :     if ($process_ans_hash){
683 :     $rh_ans->throw_error('EVAL');
684 :     return $rh_ans;
685 :     } else {
686 :     return 0;
687 :     }
688 :     }
689 :     for( my $i = 0; $i < $matrix->[1] ; $i++ ){
690 :     for( my $j = 0; $j < $matrix->[2] ; $j++ ){
691 :     if( $matrix->[0][$i][$j] != 0 and $i != $j ){
692 :     if ($process_ans_hash){
693 :     $rh_ans->throw_error('EVAL');
694 :     return $rh_ans;
695 :     } else {
696 :     return 0;
697 :     }
698 :     }
699 :     }
700 :     }
701 :     if ($process_ans_hash){
702 :     return $rh_ans;
703 :     } else {
704 :     return 1;
705 :     }
706 :     }else{
707 :     warn "There is a problem with the problem, please alert your professor.";
708 :     if ($process_ans_hash){
709 :     $rh_ans->throw_error('EVAL');
710 :     return $rh_ans;
711 :     } else {
712 :     return 0;
713 :     }
714 :     }
715 :    
716 :     }
717 :    
718 :    
719 : lr003k 1265 sub are_unit_vecs{
720 :     my ( $vec_ref,%opts ) = @_;
721 :     my @vecs = ();
722 :     if( ref($vec_ref) eq 'AnswerHash' )
723 :     {
724 :     @vecs = @{$vec_ref->{ra_student_ans}};
725 :     }else{
726 :     @vecs = @{$vec_ref};
727 :     }
728 :    
729 :     my $i = 0;
730 :     my $num = scalar(@vecs);
731 :     my $length = $vecs[0]->[1];
732 :    
733 :     for( ; $i < $num ; $i ++ )
734 :     {
735 : lr003k 1278 if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
736 : lr003k 1265 {
737 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
738 :     $vec_ref->{score} = 0;
739 : lr003k 1276 if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
740 : lr003k 1265 {
741 :     $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
742 :     }else{
743 :     $vec_ref->throw_error('EVAL');
744 :     }
745 :     return $vec_ref;
746 :     }else{
747 :     return 0;
748 :     }
749 :    
750 :     }
751 :     }
752 :    
753 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
754 :     $vec_ref->{score} = 1;
755 :     $vec_ref;
756 :     }else{
757 :     1;
758 :     }
759 :     }
760 :    
761 : lr003k 1274 sub display_correct_vecs{
762 : lr003k 1278 my ( $ra_vecs,%opts ) = @_;
763 :     my @ra_vecs = @{$ra_vecs};
764 : lr003k 1274 my @temp = ();
765 :    
766 : lr003k 1278 for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ){
767 :     push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
768 : lr003k 1274 push @temp, ",";
769 :     }
770 :    
771 : lr003k 1278 pop @temp;
772 : lr003k 1274
773 :     mbox(\@temp);
774 :    
775 :     }
776 :    
777 : lr003k 1294 sub vec_solution_cmp{
778 :     my $correctAnswer = shift;
779 :     my %opt = @_;
780 :    
781 :     set_default_options( \%opt,
782 :     'zeroLevelTol' => $main::functZeroLevelTolDefault,
783 :     'debug' => 0,
784 :     'mode' => 'basis',
785 :     'help' => 'none',
786 :     );
787 :    
788 :     $opt{debug} = 0 unless defined($opt{debug});
789 :    
790 :     ## This is where the correct answer should be checked someday.
791 :     my $matrix = Matrix->new_from_col_vecs($correctAnswer);
792 :    
793 :    
794 :     #construct the answer evaluator
795 :     my $answer_evaluator = new AnswerEvaluator;
796 :    
797 :     $answer_evaluator->{debug} = $opt{debug};
798 :     $answer_evaluator->ans_hash( correct_ans => display_correct_vecs($correctAnswer),
799 :     old_correct_ans => $correctAnswer,
800 :     rm_correct_ans => $matrix,
801 :     zeroLevelTol => $opt{zeroLevelTol},
802 :     debug => $opt{debug},
803 :     mode => $opt{mode},
804 :     help => $opt{help},
805 :     );
806 :    
807 :     $answer_evaluator->install_pre_filter(\&ans_array_filter);
808 :     $answer_evaluator->install_pre_filter(sub{
809 :     my ($rh_ans,@options) = @_;
810 :     my @student_array = @{$rh_ans->{ra_student_ans}};
811 :     my @array = ();
812 :     for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
813 :     {
814 :     push( @array, Matrix->new_from_array_ref($student_array[$i]));
815 :     }
816 :     $rh_ans->{ra_student_ans} = \@array;
817 :     $rh_ans;
818 :     });#ra_student_ans is now the students answer as an array of vectors
819 :     # anonymous subroutine to check dimension and length of the student vectors
820 :     # if either is wrong, the answer is wrong.
821 :     $answer_evaluator->install_pre_filter(sub{
822 :     my $rh_ans = shift;
823 :     my $length = $rh_ans->{rm_correct_ans}->[1];
824 :     my $dim = $rh_ans->{rm_correct_ans}->[2];
825 :     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
826 :     {
827 :    
828 :     $rh_ans->{score} = 0;
829 :     if( $rh_ans->{help} =~ /dim|verbose/ )
830 :     {
831 :     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
832 :     }else{
833 :     $rh_ans->throw_error('EVAL');
834 :     }
835 :     }
836 :     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
837 :     {
838 :     if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
839 :     {
840 :     $rh_ans->{score} = 0;
841 :     if( $rh_ans->{help} =~ /length|verbose/ )
842 :     {
843 :     $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
844 :     }else{
845 :     $rh_ans->throw_error('EVAL');
846 :     }
847 :     }
848 :     }
849 :     $rh_ans;
850 :     });
851 :     # Install prefilter for various modes
852 :     if( $opt{mode} ne 'basis' )
853 :     {
854 :     if( $opt{mode} =~ /orthogonal|orthonormal/ )
855 :     {
856 :     $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
857 :     }
858 :    
859 :     if( $opt{mode} =~ /unit|orthonormal/ )
860 :     {
861 :     $answer_evaluator->install_pre_filter(\&are_unit_vecs);
862 :    
863 :     }
864 :     }
865 :    
866 :     $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
867 :    
868 :     $answer_evaluator->install_post_filter(
869 :     sub {my $rh_ans = shift;
870 :     if ($rh_ans->catch_error('SYNTAX') ) {
871 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
872 :     $rh_ans->clear_error('SYNTAX');
873 :     }
874 :     if ($rh_ans->catch_error('EVAL') ) {
875 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
876 :     $rh_ans->clear_error('EVAL');
877 :     }
878 :     $rh_ans;
879 :     }
880 :     );
881 :     $answer_evaluator;
882 :    
883 :     }
884 :    
885 :    
886 :     sub compare_vec_solution {
887 :     my ( $rh_ans, %options ) = @_ ;
888 :     my @space = @{$rh_ans->{ra_student_ans}};
889 :     my $solution = shift @space;
890 :    
891 :     # A lot of the follosing code was taken from Matrix::proj_coeff
892 :     # calling this method recursively would be a waste of time since
893 :     # the prof's matrix never changes and solve_LR is an expensive
894 :     # operation. This way it is only done once.
895 :     my $matrix = $rh_ans->{rm_correct_ans};
896 :     my ($dim,$x_vector, $base_matrix);
897 :     my $errors = undef;
898 :     my $lin_space_tr= ~ $matrix;
899 :     $matrix = $lin_space_tr * $matrix;
900 :     my $matrix_lr = $matrix->decompose_LR();
901 :    
902 :     #this section determines whether or not the first vector, a solution to
903 :     #the system, is a linear combination of the prof's vectors in which there
904 :     #is a nonzero coefficient on the first term, the prof's solution to the system
905 :     $solution = $lin_space_tr*$solution;
906 :     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
907 :     if( $dim ){
908 :     $rh_ans->throw_error('EVAL', "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" ); # only print if the dim is not zero.
909 :     $rh_ans->{score} = 0;
910 :     $rh_ans;
911 :     }elsif( abs($x_vector->[0][0][0]) <= $options{zeroLevelTol} )
912 :     {
913 :     $rh_ans->{score} = 0;
914 :     $rh_ans;
915 :     }else{
916 :     $rh_ans->{score} = 1;
917 :     my @correct_space = @{$rh_ans->{old_correct_ans}};
918 :     shift @correct_space;
919 :     $rh_ans->{rm_correct_ans} = Matrix->new_from_col_vecs(\@correct_space);
920 :     $rh_ans->{ra_student_ans} = \@space;
921 :     return compare_basis( $rh_ans, %options );
922 :     }
923 :     }
924 : lr003k 1327
925 : lr003k 1265 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9