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

1 : gage 1064 BEGIN{
2 :     be_strict();
3 :     }
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 :    
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 :     }
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 :     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 :    
124 :     debug -- if set to 1, provides verbose listing of
125 :     hash entries throughout fliters.
126 :    
127 :     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 :    
138 :     Returns an answer evaluator.
139 :    
140 :     EXAMPLES:
141 :    
142 :     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 :    
149 :     =cut
150 :    
151 :    
152 :     sub basis_cmp {
153 :     my $correctAnswer = shift;
154 :     my %opt = @_;
155 :    
156 :     set_default_options( \%opt,
157 : gage 1896 'zeroLevelTol' => $main::functZeroLevelTolDefault,
158 :     'debug' => 0,
159 :     'mode' => 'basis',
160 :     'help' => 'none',
161 :     );
162 : gage 1071
163 :     # produce answer evaluator
164 :     BASIS_CMP(
165 : gage 1896 'correct_ans' => $correctAnswer,
166 :     'zeroLevelTol' => $opt{'zeroLevelTol'},
167 :     'debug' => $opt{'debug'},
168 :     'mode' => $opt{'mode'},
169 :     'help' => $opt{'help'},
170 : gage 1071 );
171 :     }
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 :     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 :    
188 :     ## This is where the correct answer should be checked someday.
189 :     my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
190 :    
191 :     #construct the answer evaluator
192 :     my $answer_evaluator = new AnswerEvaluator;
193 :    
194 : gage 1896 $answer_evaluator->{debug} = $mat_params{debug};
195 :     $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 :     );
203 : gage 1071
204 : gage 1896 $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 : lr003k 1123 $rh_ans;
209 :     }
210 : gage 1896 );
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 : gage 1071 }else{
226 : gage 1896 $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
227 :     vec_list_string($rh_ans, '_filter_name' => 'vec_list_string', @options);
228 : gage 1071 }
229 :     }
230 : gage 1896 );#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 : gage 1071 {
241 : gage 1896
242 : gage 1071 $rh_ans->{score} = 0;
243 : gage 1896 if( $rh_ans->{help} =~ /dim|verbose/ )
244 : gage 1071 {
245 : gage 1896 $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
246 : gage 1071 }else{
247 :     $rh_ans->throw_error('EVAL');
248 :     }
249 :     }
250 : gage 1896 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 : gage 1071 }
265 : gage 1896 );
266 : gage 1071 # Install prefilter for various modes
267 :     if( $mat_params{mode} ne 'basis' )
268 :     {
269 :     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
270 :     {
271 : lr003k 1265 $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
272 : gage 1071 }
273 :    
274 :     if( $mat_params{mode} =~ /unit|orthonormal/ )
275 :     {
276 : lr003k 1265 $answer_evaluator->install_pre_filter(\&are_unit_vecs);
277 : gage 1071
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 :     }
296 :    
297 :     =head4 compare_basis
298 :    
299 :     compare_basis( $ans_hash, %options);
300 :    
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 :    
306 :     =cut
307 :    
308 :     sub compare_basis {
309 :     my ($rh_ans, %options) = @_;
310 :     my @ch_coord;
311 :     my @vecs = @{$rh_ans->{ra_student_ans}};
312 :    
313 :     # A lot of the follosing code was taken from Matrix::proj_coeff
314 :     # calling this method recursively would be a waste of time since
315 :     # the prof's matrix never changes and solve_LR is an expensive
316 :     # operation. This way it is only done once.
317 :     my $matrix = $rh_ans->{rm_correct_ans};
318 :     my ($dim,$x_vector, $base_matrix);
319 :     my $errors = undef;
320 :     my $lin_space_tr= ~ $matrix;
321 :     $matrix = $lin_space_tr * $matrix;
322 :     my $matrix_lr = $matrix->decompose_LR();
323 :    
324 :     #finds the coefficient vectors for each of the students vectors
325 :     for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
326 :     {
327 :    
328 :     $vecs[$i] = $lin_space_tr*$vecs[$i];
329 :     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
330 :     push( @ch_coord, $x_vector );
331 :     $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.
332 :     }
333 :    
334 :     if( defined($errors))
335 :     {
336 :     $rh_ans->throw_error('EVAL', $errors) ;
337 :     }else{
338 :     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
339 :     #existence of this matrix implies that
340 :     #the all of the students answers are a
341 :     #linear combo of the prof's
342 :     $ch_coord_mat = $ch_coord_mat->decompose_LR();
343 :    
344 : lr003k 1161 if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is
345 : gage 1071 # non-zero, this implies the existence of an inverse
346 :     # which implies all of the prof's vectors are a linear
347 :     # combo of the students vectors, showing containment
348 :     # both ways.
349 :     {
350 :     # I think sometimes if the students space has the same dimension as the profs space it
351 :     # will get projected into the profs space even if it isn't a basis for that space.
352 :     # this just checks that the prof's matrix times the change of coordinate matrix is actually
353 :     #the students matrix
354 :     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} )
355 :     {
356 :     $rh_ans->{score} = 1;
357 :     }else{
358 :     $rh_ans->{score} = 0;
359 :     }
360 :     }
361 :     else{
362 :     $rh_ans->{score}=0;
363 :     }
364 :     }
365 :     $rh_ans;
366 :    
367 :     }
368 :    
369 :    
370 :     =head 2 vec_list_string
371 :    
372 :     This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
373 :     The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
374 :     Each entry can contain functions and operations and the usual math constants (pi and e).
375 :     The vectors, however can not be added or multiplied or scalar multiplied by the student.
376 :     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.
377 :     Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
378 :     but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
379 :     later when the length of the vectors is checked.
380 :     In the end, the method returns an array of Matrix objects.
381 :    
382 :    
383 :     =cut
384 :    
385 :     sub vec_list_string{
386 :     my $rh_ans = shift;
387 :     my %options = @_;
388 :     my $i;
389 :     my $entry = "";
390 :     my $char;
391 :     my @paren_stack;
392 :     my $length = length($rh_ans->{student_ans});
393 :     my @temp;
394 :     my $j = 0;
395 :     my @answers;
396 :     my $paren;
397 :     my $display_ans;
398 :    
399 :     for( $i = 0; $i < $length ; $i++ )
400 :     {
401 :     $char = substr($rh_ans->{student_ans},$i,1);
402 :    
403 :     if( $char =~ /\(|\[|\{/ ){
404 :     push( @paren_stack, $char )
405 :     }
406 :    
407 :     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
408 :     {
409 :     if( $char !~ /,|\)|\]|\}/ ){
410 :     $entry .= $char;
411 :     }else{
412 :     if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
413 :     {
414 :     if( length($entry) == 0 ){
415 :     if( $char !~ /,/ ){
416 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
417 :     }else{
418 :     $rh_ans->{preview_text_string} .= ",";
419 :     $rh_ans->{preview_latex_string} .= ",";
420 :     $display_ans .= ",";
421 :     }
422 :     }else{
423 :    
424 :     # This parser code was origianally taken from PGanswermacros::check_syntax
425 :     # but parts of it needed to be slighty modified for this context
426 :     my $parser = new AlgParserWithImplicitExpand;
427 :     my $ret = $parser -> parse($entry); #for use with loops
428 :    
429 :     if ( ref($ret) ) { ## parsed successfully
430 :     $parser -> tostring();
431 :     $parser -> normalize();
432 :     $entry = $parser -> tostring();
433 :     $rh_ans->{preview_text_string} .= $entry.",";
434 :     $rh_ans->{preview_latex_string} .= $parser -> tolatex().",";
435 :    
436 :     } else { ## error in parsing
437 :    
438 :     $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
439 :     $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
440 :     $rh_ans->{'preview_text_string'} = '',
441 :     $rh_ans->{'preview_latex_string'} = '',
442 :     $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
443 :     }
444 :    
445 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
446 :    
447 :     if ($PG_eval_errors) {
448 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
449 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
450 :     last;
451 :     } else {
452 :     $entry = prfmt($inVal,$options{format});
453 :     $display_ans .= $entry.",";
454 :     push(@temp , $entry);
455 :     }
456 :    
457 :     if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
458 :     {
459 :     pop @paren_stack;
460 :     chop($rh_ans->{preview_text_string});
461 :     chop($rh_ans->{preview_latex_string});
462 :     chop($display_ans);
463 :     $rh_ans->{preview_text_string} .= "]";
464 :     $rh_ans->{preview_latex_string} .= "]";
465 :     $display_ans .= "]";
466 :     if( scalar(@temp) > 0 )
467 :     {
468 :     push( @answers,Matrix->new_from_col_vecs([\@temp]));
469 :     while(scalar(@temp) > 0 ){
470 :     pop @temp;
471 :     }
472 :     }else{
473 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
474 :     }
475 :     }
476 :     }
477 :     $entry = "";
478 :     }else{
479 :     $paren = pop @paren_stack;
480 :     if( scalar(@paren_stack) > 0 ){
481 :     #this uses ASCII to check if the parens match up
482 :     # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
483 :     # ord ] = 93 , ord { = 123 , ord } = 125
484 :     if( (ord($char) - ord($paren) <= 2) ){
485 :     $entry = $entry . $char;
486 :     }else{
487 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
488 :     }
489 :     }
490 :     }
491 :     }
492 :     }else{
493 :     $rh_ans->{preview_text_string} .= "[";
494 :     $rh_ans->{preview_latex_string} .= "[";
495 :     $display_ans .= "[";
496 :     }
497 :     }
498 :     $rh_ans->{ra_student_ans} = \@answers;
499 :     $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
500 :     $rh_ans;
501 :     }
502 :    
503 : lr003k 1294 =head5
504 :     This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
505 :     answer entry methods. Running this filter is necessary to get all the entries out of the answer
506 :     hash. Each entry is evaluated and the resulting number is put in the display for student answer
507 :     as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
508 :     and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
509 :     for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
510 :     string is also created, but this display method becomes confusing when large matrices are used.
511 :     =cut
512 :    
513 :    
514 : lr003k 1123 sub ans_array_filter{
515 :     my $rh_ans = shift;
516 :     my %options = @_;
517 : gage 1896 # assign_option_aliases( \%opt,
518 :     # );
519 :     set_default_options(\%options,
520 :     '_filter_name' => 'ans_array_filter',
521 :     );
522 :     # $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/; # CHANGE made to accomodate HTML 4.01 standards for name attribute
523 :     $rh_ans->{ans_label} =~ /ArRaY(\d+)\_\_\d+:\d+:\d+\_\_/;
524 : lr003k 1123 my $ans_num = $1;
525 :     my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
526 :     my $key;
527 :     my @array = ();
528 :     my ($i,$j,$k) = (0,0,0);
529 :    
530 :     #the keys aren't in order, so their info has to be put into the array before doing anything with it
531 :     foreach $key (@keys){
532 : gage 1896 # $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
533 :     # ($i,$j,$k) = ($1,$2,$3);
534 :     # $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
535 :     $key =~ /ArRaY\d+\_\_(\d+):(\d+):(\d+)\_\_/;
536 : lr003k 1123 ($i,$j,$k) = ($1,$2,$3);
537 : gage 1896 $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'__'.$i.':'.$j.':'.$k.'__'};
538 :    
539 : lr003k 1123 }
540 : gage 1896 $rh_ans->{debug_student_answer }= \@array;
541 : lr003k 1123 my $display_ans = "";
542 : lr003k 1278
543 : lr003k 1123 for( $i=0; $i < scalar(@array) ; $i ++ )
544 :     {
545 :     $display_ans .= " [";
546 :     $rh_ans->{preview_text_string} .= ' [';
547 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
548 : lr003k 1123 for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
549 :     {
550 :     $display_ans .= " [";
551 :     $rh_ans->{preview_text_string} .= ' [';
552 : lr003k 1278 for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
553 : lr003k 1123 my $entry = $array[$i][$j][$k];
554 : lr003k 1238 $entry = math_constants($entry);
555 : lr003k 1123 # This parser code was origianally taken from PGanswermacros::check_syntax
556 :     # but parts of it needed to be slighty modified for this context
557 :     my $parser = new AlgParserWithImplicitExpand;
558 :     my $ret = $parser -> parse($entry); #for use with loops
559 :    
560 :     if ( ref($ret) ) { ## parsed successfully
561 :     $parser -> tostring();
562 :     $parser -> normalize();
563 :     $entry = $parser -> tostring();
564 :     $rh_ans->{preview_text_string} .= $entry.",";
565 : lr003k 1278 $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
566 : lr003k 1237
567 : lr003k 1123 } else { ## error in parsing
568 :     $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
569 :     $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
570 :     $rh_ans->{'preview_text_string'} = '',
571 :     $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
572 :     }
573 :    
574 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
575 :     if ($PG_eval_errors) {
576 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
577 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
578 :     last;
579 :     } else {
580 :     $entry = prfmt($inVal,$options{format});
581 :     $display_ans .= $entry.",";
582 :     $array[$i][$j][$k] = $entry;
583 :     }
584 :     }
585 :     chop($rh_ans->{preview_text_string});
586 :     chop($display_ans);
587 :     $rh_ans->{preview_text_string} .= '] ,';
588 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\\\\';
589 : lr003k 1123 $display_ans .= '] ,';
590 :    
591 :     }
592 :     chop($rh_ans->{preview_text_string});
593 :     chop($display_ans);
594 :     $rh_ans->{preview_text_string} .= '] ,';
595 : lr003k 1278 $rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
596 : lr003k 1123 $display_ans .= '] ,';
597 :     }
598 :     chop($rh_ans->{preview_text_string});
599 :     chop($rh_ans->{preview_latex_string});
600 : lr003k 1278 chop($rh_ans->{preview_latex_string});
601 :     chop($rh_ans->{preview_latex_string});
602 : lr003k 1123 chop($display_ans);
603 : lr003k 1278
604 : lr003k 1237 my @temp = ();
605 :     for( $i = 0 ; $i < scalar( @array ); $i++ ){
606 :     push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
607 :     push @temp , "," unless $i == scalar(@array) - 1;
608 :     }
609 :     $rh_ans->{student_ans} = mbox(\@temp);
610 : lr003k 1123 $rh_ans->{ra_student_ans} = \@array;
611 :    
612 :     $rh_ans;
613 :    
614 :     }
615 :    
616 : lr003k 1265
617 :     sub are_orthogonal_vecs{
618 : lr003k 1276 my ($vec_ref , %opts) = @_;
619 : gage 1896 $vec_ref->{_filter_name} = 'are_orthogonal_vecs';
620 : lr003k 1265 my @vecs = ();
621 :     if( ref($vec_ref) eq 'AnswerHash' )
622 :     {
623 :     @vecs = @{$vec_ref->{ra_student_ans}};
624 :     }else{
625 :     @vecs = @{$vec_ref};
626 :     }
627 :     my ($i,$j) = (0,0);
628 :    
629 :     my $num = scalar(@vecs);
630 :     my $length = $vecs[0]->[1];
631 :    
632 :     for( ; $i < $num ; $i ++ )
633 :     {
634 :     for( $j = $i+1; $j < $num ; $j++ )
635 :     {
636 : lr003k 1278 if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault )
637 : lr003k 1265 {
638 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
639 :     $vec_ref->{score} = 0;
640 : lr003k 1276 if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
641 : lr003k 1265 {
642 :     $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
643 :     }else{
644 :     $vec_ref->throw_error('EVAL');
645 :     }
646 :     return $vec_ref;
647 :     }else{
648 :     return 0;
649 :     }
650 :     }
651 :     }
652 :     }
653 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
654 :     $vec_ref->{score} = 1;
655 :     $vec_ref;
656 :     }else{
657 :     1;
658 :     }
659 :     }
660 :    
661 : lr003k 1327 sub is_diagonal{
662 :     my $matrix = shift;
663 :     my %options = @_;
664 :     my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
665 :     my ($rh_ans);
666 :     if ($process_ans_hash) {
667 :     $rh_ans = $matrix;
668 :     $matrix = $rh_ans->{ra_student_ans};
669 :     }
670 :    
671 :     return 0 unless defined($matrix);
672 :    
673 :     if( ref($matrix) eq 'ARRAY' ){
674 :     my @matrix = @{$matrix};
675 :     @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
676 :     if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
677 :     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.";
678 :     }
679 :    
680 :     for( my $i = 0; $i < scalar( @matrix ) ; $i++ ){
681 :     for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
682 :     if( $matrix[$i][$j] != 0 and $i != $j )
683 :     {
684 :     if ($process_ans_hash){
685 :     $rh_ans->throw_error('EVAL');
686 :     return $rh_ans;
687 :     } else {
688 :     return 0;
689 :     }
690 :     }
691 :     }
692 :     }
693 :     if ($process_ans_hash){
694 :     return $rh_ans;
695 :     } else {
696 :     return 1;
697 :     }
698 :     }elsif( ref($matrix) eq 'Matrix' ){
699 :     if( $matrix->[1] != $matrix->[2] ){
700 :     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.";
701 :     if ($process_ans_hash){
702 :     $rh_ans->throw_error('EVAL');
703 :     return $rh_ans;
704 :     } else {
705 :     return 0;
706 :     }
707 :     }
708 :     for( my $i = 0; $i < $matrix->[1] ; $i++ ){
709 :     for( my $j = 0; $j < $matrix->[2] ; $j++ ){
710 :     if( $matrix->[0][$i][$j] != 0 and $i != $j ){
711 :     if ($process_ans_hash){
712 :     $rh_ans->throw_error('EVAL');
713 :     return $rh_ans;
714 :     } else {
715 :     return 0;
716 :     }
717 :     }
718 :     }
719 :     }
720 :     if ($process_ans_hash){
721 :     return $rh_ans;
722 :     } else {
723 :     return 1;
724 :     }
725 :     }else{
726 :     warn "There is a problem with the problem, please alert your professor.";
727 :     if ($process_ans_hash){
728 :     $rh_ans->throw_error('EVAL');
729 :     return $rh_ans;
730 :     } else {
731 :     return 0;
732 :     }
733 :     }
734 :    
735 :     }
736 :    
737 :    
738 : lr003k 1265 sub are_unit_vecs{
739 :     my ( $vec_ref,%opts ) = @_;
740 : gage 1896 $vec_ref->{_filter_name} = 'are_unit_vecs';
741 : lr003k 1265 my @vecs = ();
742 :     if( ref($vec_ref) eq 'AnswerHash' )
743 :     {
744 :     @vecs = @{$vec_ref->{ra_student_ans}};
745 :     }else{
746 :     @vecs = @{$vec_ref};
747 :     }
748 :    
749 :     my $i = 0;
750 :     my $num = scalar(@vecs);
751 :     my $length = $vecs[0]->[1];
752 :    
753 :     for( ; $i < $num ; $i ++ )
754 :     {
755 : lr003k 1278 if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
756 : lr003k 1265 {
757 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
758 :     $vec_ref->{score} = 0;
759 : lr003k 1276 if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
760 : lr003k 1265 {
761 :     $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
762 :     }else{
763 :     $vec_ref->throw_error('EVAL');
764 :     }
765 :     return $vec_ref;
766 :     }else{
767 :     return 0;
768 :     }
769 :    
770 :     }
771 :     }
772 :    
773 :     if( ref( $vec_ref ) eq 'AnswerHash' ){
774 :     $vec_ref->{score} = 1;
775 :     $vec_ref;
776 :     }else{
777 :     1;
778 :     }
779 :     }
780 :    
781 : lr003k 1274 sub display_correct_vecs{
782 : lr003k 1278 my ( $ra_vecs,%opts ) = @_;
783 :     my @ra_vecs = @{$ra_vecs};
784 : lr003k 1274 my @temp = ();
785 :    
786 : lr003k 1278 for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ){
787 :     push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
788 : lr003k 1274 push @temp, ",";
789 :     }
790 :    
791 : lr003k 1278 pop @temp;
792 : lr003k 1274
793 :     mbox(\@temp);
794 :    
795 :     }
796 :    
797 : lr003k 1294 sub vec_solution_cmp{
798 :     my $correctAnswer = shift;
799 :     my %opt = @_;
800 :    
801 :     set_default_options( \%opt,
802 :     'zeroLevelTol' => $main::functZeroLevelTolDefault,
803 :     'debug' => 0,
804 :     'mode' => 'basis',
805 :     'help' => 'none',
806 :     );
807 :    
808 :     $opt{debug} = 0 unless defined($opt{debug});
809 :    
810 :     ## This is where the correct answer should be checked someday.
811 :     my $matrix = Matrix->new_from_col_vecs($correctAnswer);
812 :    
813 :    
814 :     #construct the answer evaluator
815 :     my $answer_evaluator = new AnswerEvaluator;
816 :    
817 :     $answer_evaluator->{debug} = $opt{debug};
818 :     $answer_evaluator->ans_hash( correct_ans => display_correct_vecs($correctAnswer),
819 :     old_correct_ans => $correctAnswer,
820 :     rm_correct_ans => $matrix,
821 :     zeroLevelTol => $opt{zeroLevelTol},
822 :     debug => $opt{debug},
823 :     mode => $opt{mode},
824 :     help => $opt{help},
825 :     );
826 :    
827 :     $answer_evaluator->install_pre_filter(\&ans_array_filter);
828 :     $answer_evaluator->install_pre_filter(sub{
829 :     my ($rh_ans,@options) = @_;
830 :     my @student_array = @{$rh_ans->{ra_student_ans}};
831 :     my @array = ();
832 :     for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
833 :     {
834 :     push( @array, Matrix->new_from_array_ref($student_array[$i]));
835 :     }
836 :     $rh_ans->{ra_student_ans} = \@array;
837 :     $rh_ans;
838 :     });#ra_student_ans is now the students answer as an array of vectors
839 :     # anonymous subroutine to check dimension and length of the student vectors
840 :     # if either is wrong, the answer is wrong.
841 :     $answer_evaluator->install_pre_filter(sub{
842 :     my $rh_ans = shift;
843 :     my $length = $rh_ans->{rm_correct_ans}->[1];
844 :     my $dim = $rh_ans->{rm_correct_ans}->[2];
845 :     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
846 :     {
847 :    
848 :     $rh_ans->{score} = 0;
849 :     if( $rh_ans->{help} =~ /dim|verbose/ )
850 :     {
851 :     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
852 :     }else{
853 :     $rh_ans->throw_error('EVAL');
854 :     }
855 :     }
856 :     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
857 :     {
858 :     if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
859 :     {
860 :     $rh_ans->{score} = 0;
861 :     if( $rh_ans->{help} =~ /length|verbose/ )
862 :     {
863 :     $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
864 :     }else{
865 :     $rh_ans->throw_error('EVAL');
866 :     }
867 :     }
868 :     }
869 :     $rh_ans;
870 :     });
871 :     # Install prefilter for various modes
872 :     if( $opt{mode} ne 'basis' )
873 :     {
874 :     if( $opt{mode} =~ /orthogonal|orthonormal/ )
875 :     {
876 :     $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
877 :     }
878 :    
879 :     if( $opt{mode} =~ /unit|orthonormal/ )
880 :     {
881 :     $answer_evaluator->install_pre_filter(\&are_unit_vecs);
882 :    
883 :     }
884 :     }
885 :    
886 :     $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
887 :    
888 :     $answer_evaluator->install_post_filter(
889 :     sub {my $rh_ans = shift;
890 :     if ($rh_ans->catch_error('SYNTAX') ) {
891 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
892 :     $rh_ans->clear_error('SYNTAX');
893 :     }
894 :     if ($rh_ans->catch_error('EVAL') ) {
895 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
896 :     $rh_ans->clear_error('EVAL');
897 :     }
898 :     $rh_ans;
899 :     }
900 :     );
901 :     $answer_evaluator;
902 :    
903 :     }
904 :    
905 :    
906 :     sub compare_vec_solution {
907 :     my ( $rh_ans, %options ) = @_ ;
908 :     my @space = @{$rh_ans->{ra_student_ans}};
909 :     my $solution = shift @space;
910 :    
911 :     # A lot of the follosing code was taken from Matrix::proj_coeff
912 :     # calling this method recursively would be a waste of time since
913 :     # the prof's matrix never changes and solve_LR is an expensive
914 :     # operation. This way it is only done once.
915 :     my $matrix = $rh_ans->{rm_correct_ans};
916 :     my ($dim,$x_vector, $base_matrix);
917 :     my $errors = undef;
918 :     my $lin_space_tr= ~ $matrix;
919 :     $matrix = $lin_space_tr * $matrix;
920 :     my $matrix_lr = $matrix->decompose_LR();
921 :    
922 :     #this section determines whether or not the first vector, a solution to
923 :     #the system, is a linear combination of the prof's vectors in which there
924 :     #is a nonzero coefficient on the first term, the prof's solution to the system
925 :     $solution = $lin_space_tr*$solution;
926 :     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
927 :     if( $dim ){
928 :     $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.
929 :     $rh_ans->{score} = 0;
930 :     $rh_ans;
931 :     }elsif( abs($x_vector->[0][0][0]) <= $options{zeroLevelTol} )
932 :     {
933 :     $rh_ans->{score} = 0;
934 :     $rh_ans;
935 :     }else{
936 : gage 1896 $rh_ans->{score} = 1;
937 :     my @correct_space = @{$rh_ans->{old_correct_ans}};
938 :     shift @correct_space;
939 :     $rh_ans->{rm_correct_ans} = Matrix->new_from_col_vecs(\@correct_space);
940 :     $rh_ans->{ra_student_ans} = \@space;
941 :     return compare_basis( $rh_ans, %options );
942 : lr003k 1294 }
943 :     }
944 : lr003k 1327
945 : sh002i 1534 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9