[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 3314 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9