[system] / branches / rel-2-1-patches / pg / macros / PGmorematrixmacros.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /branches/rel-2-1-patches/pg/macros/PGmorematrixmacros.pl

Wed Jul 9 18:06:52 2003 UTC (9 years, 10 months ago) by lr003k
Original Path: trunk/pg/macros/PGmorematrixmacros.pl
File size: 28602 byte(s)
Added a pretty_matrix sub routine to fix some rounding problems.


    1 #!/usr/local/bin/webwork-perl
2
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 =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 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 =head3 basis_cmp() 109 110 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
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   $answer_evaluator->ans_hash( correct_ans => display_correct_vecs($mat_params{correct_ans}),
198           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$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       $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
222       vec_list_string($rh_ans,@options); 223 } 224 225 });#ra_student_ans is now the students answer as an array of vectors 226 # 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$answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
264     }
265
266     if( $mat_params{mode} =~ /unit|orthonormal/ ) 267 { 268$answer_evaluator->install_pre_filter(\&are_unit_vecs);
269
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 if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is 337 # 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
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
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 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 525 for($i=0; $i < scalar(@array) ;$i ++ )
526   {
527     $display_ans .= " ["; 528$rh_ans->{preview_text_string} .= ' [';
529           $rh_ans->{preview_latex_string} .= '\begin{pmatrix} '; 530 for($j = 0; $j < scalar( @{$array[$i]} ) ;$j++ )
531     {
532       $display_ans .= " ["; 533$rh_ans->{preview_text_string} .= ' [';
534                   for( $k = 0;$k < scalar( @{$array[$i][$j]} ) ;$k ++ ){
535         my $entry =$array[$i][$j][$k]; 536$entry = math_constants($entry); 537 # 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           $rh_ans->{preview_latex_string} .=$parser -> tolatex() . '& ';
548
549         } 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                  $rh_ans->{preview_latex_string} .= '\\\\'; 571$display_ans .= '] ,';
572
573     }
574     chop($rh_ans->{preview_text_string}); 575 chop($display_ans);
576                 $rh_ans->{preview_text_string} .= '] ,'; 577$rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
578     $display_ans .= '] ,'; 579 } 580 chop($rh_ans->{preview_text_string});
581   chop($rh_ans->{preview_latex_string}); 582 chop($rh_ans->{preview_latex_string});
583   chop($rh_ans->{preview_latex_string}); 584 chop($display_ans);
585
586   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$rh_ans->{ra_student_ans} = \@array;
593
594   $rh_ans; 595 596 } 597 598 599 sub are_orthogonal_vecs{ 600 my ($vec_ref , %opts) = @_;
601   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       if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault ) 618 { 619 if( ref($vec_ref ) eq 'AnswerHash' ){
620           $vec_ref->{score} = 0; 621 if($vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
622           {
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 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 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 if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) >$main::functZeroLevelTolDefault )
736     {
737       if( ref( $vec_ref ) eq 'AnswerHash' ){ 738$vec_ref->{score} = 0;
739         if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ ) 740 { 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 sub display_correct_vecs{ 762 my ($ra_vecs,%opts ) = @_;
763   my @ra_vecs = @{$ra_vecs}; 764 my @temp = (); 765 766 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     push @temp, ",";
769   }
770
771   pop @temp;
772
773   mbox(\@temp);
774
775 }
776
777 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
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 925 sub pretty_matrix{ 926 my$matrix = shift;
927
928   if( ref($matrix) ne 'Matrix' ){ 929 warn "Usage: \$pretty_matrix = pretty_matrix(\$matrix)"; 930 } 931 932 for( my$i = 0; $i <$matrix->[1]; $i++ ){ 933 for( my$j = 0; $j <$matrix->[2]; $j++ ){ 934 if($matrix->[0][$i][$j] - sprintf("%.0f", $matrix->[0][$i][$j] ) <$main::functZeroLevelTolDefault ){
935         $matrix->[0][$i][$j] = sprintf("%.0f",$matrix->[0][$i][$j] );
936         $matrix->[0][$i][$j] = 0 if($matrix->[0][$i][$j] == 0);
937       }
938     }
939   }
940   \$matrix;
941 }
942
943 1;