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

1 : gage 1064
2 : apizer 1080
3 : gage 1064 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 :     sub swap_rows{
30 :    
31 :     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
32 :     if (@_ != 3);
33 :     my $matrix = $_[0];
34 :     my ($i,$j) = ($_[1],$_[2]);
35 :     warn "Error: Rows to be swapped must exist!"
36 :     if ($i>@$matrix or $j >@$matrix);
37 :     warn "Warning: Swapping the same row is pointless"
38 :     if ($i==$j);
39 :     my $cols = @{$matrix->[0]};
40 :     my $B = new Matrix(@$matrix,$cols);
41 :     foreach my $k (1..$cols){
42 :     $B->assign($i,$k,element $matrix($j,$k));
43 :     $B->assign($j,$k,element $matrix($i,$k));
44 :     }
45 :     return $B;
46 :     }
47 :    
48 :     sub row_mult{
49 :    
50 :     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
51 :     if (@_ != 3);
52 :     my $matrix = $_[0];
53 :     my ($scalar,$row) = ($_[1],$_[2]);
54 :     warn "Undefined row multiplication"
55 :     if ($row > @$matrix);
56 :     my $B = new Matrix(@$matrix,@{$matrix->[0]});
57 :     foreach my $j (1..@{$matrix->[0]}) {
58 :     $B->assign($row,$j,$scalar*element $matrix($row,$j));
59 :     }
60 :     return $B;
61 :     }
62 :    
63 :     sub linear_combo{
64 :    
65 :     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
66 :     if (@_ != 4);
67 :     my $matrix = $_[0];
68 :     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
69 :     warn "Undefined row in multiplication"
70 :     if ($row1>@$matrix or $row2>@$matrix);
71 :     warn "Warning: Using the same row"
72 :     if ($row1==$row2);
73 :     my $B = new Matrix(@$matrix,@{$matrix->[0]});
74 :     foreach my $j (1..@$matrix) {
75 :     my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
76 :     $B->assign($row2,$j,$scalar*$t1+$t2);
77 :     }
78 :     return $B;
79 :     }
80 :    
81 : gage 1071 =head3 basis_cmp()
82 : gage 1064
83 : gage 1071 Compares a list of vectors by finding the change of coordinate matrix
84 :     from the Prof's vectors to the students, and then taking the determinant of
85 :     that to determine the existence of the change of coordinate matrix going the
86 :     other way.
87 :    
88 :     ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
89 :    
90 :     1. a reference to an array of correct vectors
91 :     2. a hash with the following keys (all optional):
92 :     mode -- 'basis' (default) (only a basis allowed)
93 :     'orthogonal' (only an orthogonal basis is allowed)
94 :     'unit' (only unit vectors in the basis allowed)
95 :     'orthonormal' (only orthogonal unit vectors in basis allowed)
96 :     zeroLevelTol -- absolute tolerance to allow when answer is close
97 :     to zero
98 :    
99 :     debug -- if set to 1, provides verbose listing of
100 :     hash entries throughout fliters.
101 :    
102 :     help -- 'none' (default) (is quiet on all errors)
103 :     'dim' (Tells student if wrong number of vectors are entered)
104 :     'length' (Tells student if there is a vector of the wrong length)
105 :     'orthogonal' (Tells student if their vectors are not orthogonal)
106 :     (This is only in orthogonal mode)
107 :     'unit' (Tells student if there is a vector not of unit length)
108 :     (This is only in unit mode)
109 :     'orthonormal' (Gives errors from orthogonal and orthonormal)
110 :     (This is only in orthonormal mode)
111 :     'verbose' (Gives all the above answer messages)
112 :    
113 :     Returns an answer evaluator.
114 :    
115 :     EXAMPLES:
116 :    
117 :     basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
118 :     -- correct answer is any basis for R^3.
119 :     basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
120 :     -- correct answer is any orthonormal basis
121 :     for this space such as:
122 :     [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
123 :    
124 :     =cut
125 :    
126 :    
127 :     sub basis_cmp {
128 :     my $correctAnswer = shift;
129 :     my %opt = @_;
130 :    
131 :     set_default_options( \%opt,
132 :     'zeroLevelTol' => $main::functZeroLevelTolDefault,
133 :     'debug' => 0,
134 :     'mode' => 'basis',
135 :     'help' => 'none',
136 :     );
137 :    
138 :     # produce answer evaluator
139 :     BASIS_CMP(
140 :     'correct_ans' => $correctAnswer,
141 :     'zeroLevelTol' => $opt{'zeroLevelTol'},
142 :     'debug' => $opt{'debug'},
143 :     'mode' => $opt{'mode'},
144 :     'help' => $opt{'help'},
145 :     );
146 :     }
147 :    
148 :     =head BASIS_CMP
149 :    
150 :     Made to keep the same format as num_cmp and fun_cmp.
151 :    
152 :     =cut
153 :    
154 :     sub BASIS_CMP {
155 :     my %mat_params = @_;
156 :     my $zeroLevelTol = $mat_params{'zeroLevelTol'};
157 :    
158 :     # Check that everything is defined:
159 :     $mat_params{debug} = 0 unless defined($mat_params{debug});
160 :     $zeroLevelTol = $main::functZeroLevelTolDefault unless defined $zeroLevelTol;
161 :     $mat_params{'zeroLevelTol'} = $zeroLevelTol;
162 :    
163 :     ## This is where the correct answer should be checked someday.
164 :     my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
165 :    
166 :     #construct the answer evaluator
167 :     my $answer_evaluator = new AnswerEvaluator;
168 :    
169 :     $answer_evaluator->{debug} = $mat_params{debug};
170 :    
171 :     $answer_evaluator->ans_hash( correct_ans => pretty_print($mat_params{correct_ans}),
172 :     rm_correct_ans => $matrix,
173 :     zeroLevelTol => $mat_params{zeroLevelTol},
174 :     debug => $mat_params{debug},
175 :     mode => $mat_params{mode},
176 :     help => $mat_params{help},
177 :     );
178 :    
179 :     $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
180 :     $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace
181 :     $rh_ans;
182 :     });
183 :    
184 :     $answer_evaluator->install_pre_filter(\&math_constants);
185 :     $answer_evaluator->install_pre_filter(\&vec_list_string);#ra_student_ans is now the students answer as an array of vectors
186 :     # anonymous subroutine to check dimension and length of the student vectors
187 :     # if either is wrong, the answer is wrong.
188 :     $answer_evaluator->install_pre_filter(sub{
189 :     my $rh_ans = shift;
190 :     my $length = $rh_ans->{rm_correct_ans}->[1];
191 :     my $dim = $rh_ans->{rm_correct_ans}->[2];
192 :     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
193 :     {
194 :    
195 :     $rh_ans->{score} = 0;
196 :     if( $rh_ans->{help} =~ /dim|verbose/ )
197 :     {
198 :     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
199 :     }else{
200 :     $rh_ans->throw_error('EVAL');
201 :     }
202 :     }
203 :     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
204 :     {
205 :     if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
206 :     {
207 :     $rh_ans->{score} = 0;
208 :     if( $rh_ans->{help} =~ /length|verbose/ )
209 :     {
210 :     $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
211 :     }else{
212 :     $rh_ans->throw_error('EVAL');
213 :     }
214 :     }
215 :     }
216 :     $rh_ans;
217 :     });
218 :     # Install prefilter for various modes
219 :     if( $mat_params{mode} ne 'basis' )
220 :     {
221 :     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
222 :     {
223 :     $answer_evaluator->install_pre_filter(sub{
224 :     my $rh_ans = shift;
225 :     my @vecs = @{$rh_ans->{ra_student_ans}};
226 :     my ($i,$j) = (0,0);
227 :     my $num = scalar(@vecs);
228 :     my $length = $vecs[0]->[1];
229 :    
230 :     for( ; $i < $num ; $i ++ )
231 :     {
232 :     for( $j = $i+1; $j < $num ; $j++ )
233 :     {
234 :     my $sum = 0;
235 :     my $k = 0;
236 :    
237 :     for( ; $k < $length; $k++ ) {
238 :     $sum += $vecs[$i]->[0][$k][0]*$vecs[$j]->[0][$k][0];
239 :     }
240 :    
241 :     if( $sum > $mat_params{zeroLevelTol} )
242 :     {
243 :     $rh_ans->{score} = 0;
244 :     if( $rh_ans->{help} =~ /orthogonal|orthonormal|verbose/ )
245 :     {
246 :     $rh_ans->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
247 :     }else{
248 :     $rh_ans->throw_error('EVAL');
249 :     }
250 :     }
251 :     }
252 :     }
253 :    
254 :    
255 :     $rh_ans;
256 :     });
257 :     }
258 :    
259 :     if( $mat_params{mode} =~ /unit|orthonormal/ )
260 :     {
261 :     $answer_evaluator->install_pre_filter(sub{
262 :     my $rh_ans = shift;
263 :     my @vecs = @{$rh_ans->{ra_student_ans}};
264 :     my $i = 0;
265 :     my $num = scalar(@vecs);
266 :     my $length = $vecs[0]->[1];
267 :    
268 :     for( ; $i < $num ; $i ++ )
269 :     {
270 :     my $sum = 0;
271 :     my $k = 0;
272 :    
273 :     for( ; $k < $length; $k++ ) {
274 :     $sum += $vecs[$i]->[0][$k][0]*$vecs[$i]->[0][$k][0];
275 :     }
276 :     if( abs(sqrt($sum) - 1) > $mat_params{zeroLevelTol} )
277 :     {
278 :     $rh_ans->{score} = 0;
279 :    
280 :     if( $rh_ans->{help} =~ /unit|orthonormal|verbose/ )
281 :     {
282 :     $rh_ans->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
283 :     }else{
284 :     $rh_ans->throw_error('EVAL');
285 :     }
286 :     }
287 :     }
288 :    
289 :    
290 :     $rh_ans;
291 :     });
292 :    
293 :     }
294 :     }
295 :     $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
296 :     $answer_evaluator->install_post_filter(
297 :     sub {my $rh_ans = shift;
298 :     if ($rh_ans->catch_error('SYNTAX') ) {
299 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
300 :     $rh_ans->clear_error('SYNTAX');
301 :     }
302 :     if ($rh_ans->catch_error('EVAL') ) {
303 :     $rh_ans->{ans_message} = $rh_ans->{error_message};
304 :     $rh_ans->clear_error('EVAL');
305 :     }
306 :     $rh_ans;
307 :     }
308 :     );
309 :     $answer_evaluator;
310 :     }
311 :    
312 :     =head4 compare_basis
313 :    
314 :     compare_basis( $ans_hash, %options);
315 :    
316 :     {ra_student_ans}, # a reference to the array of students answer vectors
317 :     {rm_correct_ans}, # a reference to the correct answer matrix
318 :     %options
319 :     )
320 :    
321 :     =cut
322 :    
323 :     sub compare_basis {
324 :     my ($rh_ans, %options) = @_;
325 :     my @ch_coord;
326 :     my @vecs = @{$rh_ans->{ra_student_ans}};
327 :    
328 :     # A lot of the follosing code was taken from Matrix::proj_coeff
329 :     # calling this method recursively would be a waste of time since
330 :     # the prof's matrix never changes and solve_LR is an expensive
331 :     # operation. This way it is only done once.
332 :     my $matrix = $rh_ans->{rm_correct_ans};
333 :     my ($dim,$x_vector, $base_matrix);
334 :     my $errors = undef;
335 :     my $lin_space_tr= ~ $matrix;
336 :     $matrix = $lin_space_tr * $matrix;
337 :     my $matrix_lr = $matrix->decompose_LR();
338 :    
339 :     #finds the coefficient vectors for each of the students vectors
340 :     for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
341 :     {
342 :    
343 :     $vecs[$i] = $lin_space_tr*$vecs[$i];
344 :     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
345 :     push( @ch_coord, $x_vector );
346 :     $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.
347 :     }
348 :    
349 :     if( defined($errors))
350 :     {
351 :     $rh_ans->throw_error('EVAL', $errors) ;
352 :     }else{
353 :     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
354 :     #existence of this matrix implies that
355 :     #the all of the students answers are a
356 :     #linear combo of the prof's
357 :     $ch_coord_mat = $ch_coord_mat->decompose_LR();
358 :    
359 :     if( $ch_coord_mat->det_LR() > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is
360 :     # non-zero, this implies the existence of an inverse
361 :     # which implies all of the prof's vectors are a linear
362 :     # combo of the students vectors, showing containment
363 :     # both ways.
364 :     {
365 :     # I think sometimes if the students space has the same dimension as the profs space it
366 :     # will get projected into the profs space even if it isn't a basis for that space.
367 :     # this just checks that the prof's matrix times the change of coordinate matrix is actually
368 :     #the students matrix
369 :     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} )
370 :     {
371 :     $rh_ans->{score} = 1;
372 :     }else{
373 :     $rh_ans->{score} = 0;
374 :     }
375 :     }
376 :     else{
377 :     $rh_ans->{score}=0;
378 :     }
379 :     }
380 :     $rh_ans;
381 :    
382 :     }
383 :    
384 :    
385 :     =head 2 vec_list_string
386 :    
387 :     This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
388 :     The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
389 :     Each entry can contain functions and operations and the usual math constants (pi and e).
390 :     The vectors, however can not be added or multiplied or scalar multiplied by the student.
391 :     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.
392 :     Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
393 :     but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
394 :     later when the length of the vectors is checked.
395 :     In the end, the method returns an array of Matrix objects.
396 :    
397 :    
398 :     =cut
399 :    
400 :     sub vec_list_string{
401 :     my $rh_ans = shift;
402 :     my %options = @_;
403 :     my $i;
404 :     my $entry = "";
405 :     my $char;
406 :     my @paren_stack;
407 :     my $length = length($rh_ans->{student_ans});
408 :     my @temp;
409 :     my $j = 0;
410 :     my @answers;
411 :     my $paren;
412 :     my $display_ans;
413 :    
414 :     for( $i = 0; $i < $length ; $i++ )
415 :     {
416 :     $char = substr($rh_ans->{student_ans},$i,1);
417 :    
418 :     if( $char =~ /\(|\[|\{/ ){
419 :     push( @paren_stack, $char )
420 :     }
421 :    
422 :     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
423 :     {
424 :     if( $char !~ /,|\)|\]|\}/ ){
425 :     $entry .= $char;
426 :     }else{
427 :     if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
428 :     {
429 :     if( length($entry) == 0 ){
430 :     if( $char !~ /,/ ){
431 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
432 :     }else{
433 :     $rh_ans->{preview_text_string} .= ",";
434 :     $rh_ans->{preview_latex_string} .= ",";
435 :     $display_ans .= ",";
436 :     }
437 :     }else{
438 :    
439 :     # This parser code was origianally taken from PGanswermacros::check_syntax
440 :     # but parts of it needed to be slighty modified for this context
441 :     my $parser = new AlgParserWithImplicitExpand;
442 :     my $ret = $parser -> parse($entry); #for use with loops
443 :    
444 :     if ( ref($ret) ) { ## parsed successfully
445 :     $parser -> tostring();
446 :     $parser -> normalize();
447 :     $entry = $parser -> tostring();
448 :     $rh_ans->{preview_text_string} .= $entry.",";
449 :     $rh_ans->{preview_latex_string} .= $parser -> tolatex().",";
450 :    
451 :     } else { ## error in parsing
452 :    
453 :     $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
454 :     $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
455 :     $rh_ans->{'preview_text_string'} = '',
456 :     $rh_ans->{'preview_latex_string'} = '',
457 :     $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
458 :     }
459 :    
460 :     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
461 :    
462 :     if ($PG_eval_errors) {
463 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
464 :     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
465 :     last;
466 :     } else {
467 :     $entry = prfmt($inVal,$options{format});
468 :     $display_ans .= $entry.",";
469 :     push(@temp , $entry);
470 :     }
471 :    
472 :     if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
473 :     {
474 :     pop @paren_stack;
475 :     chop($rh_ans->{preview_text_string});
476 :     chop($rh_ans->{preview_latex_string});
477 :     chop($display_ans);
478 :     $rh_ans->{preview_text_string} .= "]";
479 :     $rh_ans->{preview_latex_string} .= "]";
480 :     $display_ans .= "]";
481 :     if( scalar(@temp) > 0 )
482 :     {
483 :     push( @answers,Matrix->new_from_col_vecs([\@temp]));
484 :     while(scalar(@temp) > 0 ){
485 :     pop @temp;
486 :     }
487 :     }else{
488 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
489 :     }
490 :     }
491 :     }
492 :     $entry = "";
493 :     }else{
494 :     $paren = pop @paren_stack;
495 :     if( scalar(@paren_stack) > 0 ){
496 :     #this uses ASCII to check if the parens match up
497 :     # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
498 :     # ord ] = 93 , ord { = 123 , ord } = 125
499 :     if( (ord($char) - ord($paren) <= 2) ){
500 :     $entry = $entry . $char;
501 :     }else{
502 :     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
503 :     }
504 :     }
505 :     }
506 :     }
507 :     }else{
508 :     $rh_ans->{preview_text_string} .= "[";
509 :     $rh_ans->{preview_latex_string} .= "[";
510 :     $display_ans .= "[";
511 :     }
512 :     }
513 :     $rh_ans->{ra_student_ans} = \@answers;
514 :     $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
515 :     $rh_ans;
516 :     }
517 :    
518 : gage 1064 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9