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

Diff of /trunk/pg/macros/PGmatrixmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1080 Revision 1097
12 12
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
16Almost all of the macros in the file are very rough at best. The most useful is display_matrix. 16Almost all of the macros in the file are very rough at best. The most useful is display_matrix.
17Many of the other macros work with vectors and matrices stored as anonymous arrays. 17Many of the other macros work with vectors and matrices stored as anonymous arrays.
18 18
19Frequently it may be 19Frequently it may be
20more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there. 20more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there.
21 21
22 22
28 28
29sub _PGmatrixmacros_init { 29sub _PGmatrixmacros_init {
30} 30}
31 31
32# this subroutine zero_check is not very well designed below -- if it is used much it should receive 32# this subroutine zero_check is not very well designed below -- if it is used much it should receive
33# more work -- particularly for checking relative tolerance. More work needs to be done if this is 33# more work -- particularly for checking relative tolerance. More work needs to be done if this is
34# actually used. 34# actually used.
35 35
36sub zero_check{ 36sub zero_check{
37 my $array = shift; 37 my $array = shift;
38 my %options = @_; 38 my %options = @_;
61 } 61 }
62 $sum; 62 $sum;
63} 63}
64sub proj_vec { 64sub proj_vec {
65 my $vec = shift; 65 my $vec = shift;
66 warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; 66 warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1;
67 my $matrix = shift; # the matrix represents a set of vectors spanning the linear space 67 my $matrix = shift; # the matrix represents a set of vectors spanning the linear space
68 # onto which we want to project the vector. 68 # onto which we want to project the vector.
69 warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0]; 69 warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0];
70 $matrix * transpose($matrix) * $vec; 70 $matrix * transpose($matrix) * $vec;
71} 71}
72 72
73sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector 73sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector
74 my $correct_vector = shift; 74 my $correct_vector = shift;
75 my %options = @_; 75 my %options = @_;
76 my $ans_eval = sub { 76 my $ans_eval = sub {
77 my $in = shift @_; 77 my $in = shift @_;
78 78
79 my $ans_hash = new AnswerHash; 79 my $ans_hash = new AnswerHash;
80 my @in = split("\0",$in); 80 my @in = split("\0",$in);
81 my @correct_vector=@$correct_vector; 81 my @correct_vector=@$correct_vector;
82 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 82 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )";
83 $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; 83 $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )";
84 84
85 return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension 85 return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension
86 86
87 my $correct_length = vec_dot($correct_vector,$correct_vector); 87 my $correct_length = vec_dot($correct_vector,$correct_vector);
88 my $in_length = vec_dot(\@in,\@in); 88 my $in_length = vec_dot(\@in,\@in);
89 return($ans_hash) if $in_length == 0; 89 return($ans_hash) if $in_length == 0;
90 90
91 if (defined($correct_length) and $correct_length != 0) { 91 if (defined($correct_length) and $correct_length != 0) {
92 my $constant = vec_dot($correct_vector,\@in)/$correct_length; 92 my $constant = vec_dot($correct_vector,\@in)/$correct_length;
93 my @difference = (); 93 my @difference = ();
94 for(my $i=0; $i < @correct_vector; $i++ ) { 94 for(my $i=0; $i < @correct_vector; $i++ ) {
95 $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; 95 $difference[$i]=$constant*$correct_vector[$i] - $in[$i];
96 } 96 }
97 $ans_hash->{score} = zero_check(\@difference); 97 $ans_hash->{score} = zero_check(\@difference);
98 98
99 } else { 99 } else {
100 $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; 100 $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0;
101 } 101 }
102 $ans_hash; 102 $ans_hash;
103 103
104 }; 104 };
105 105
106 $ans_eval; 106 $ans_eval;
107} 107}
108 108
109############ 109############
110 110
158 158
159 159
160=cut 160=cut
161 161
162 162
163sub display_matrix_mm{ # will display a matrix in tex format. 163sub display_matrix_mm{ # will display a matrix in tex format.
164 # the matrix can be either of type array or type 'Matrix' 164 # the matrix can be either of type array or type 'Matrix'
165 return display_matrix(@_, 'force_tex'=>1); 165 return display_matrix(@_, 'force_tex'=>1);
166} 166}
167 167
168sub display_matrix_math_mode { 168sub display_matrix_math_mode {
170} 170}
171 171
172sub display_matrix { 172sub display_matrix {
173 my $ra_matrix = shift; 173 my $ra_matrix = shift;
174 my %opts = @_; 174 my %opts = @_;
175 # Now a global variable?
176 my $styleParams = defined($main::defaultDisplayMatrixStyle) ? 175 my $styleParams = defined($main::defaultDisplayMatrixStyle) ?
177 $main::defaultDisplayMatrixStyle : "(s)"; 176 $main::defaultDisplayMatrixStyle : "(s)";
178 177
179 set_default_options(\%opts, 178 set_default_options(\%opts,
180 '_filter_name' => 'display_matrix', 179 '_filter_name' => 'display_matrix',
181 'force_tex' => 0, 180 'force_tex' => 0,
182 'left' => substr($styleParams,0,1), 181 'left' => substr($styleParams,0,1),
183 'right' => substr($styleParams,2,1), 182 'right' => substr($styleParams,2,1),
184 'midrule' => substr($styleParams,1,1), 183 'midrule' => substr($styleParams,1,1),
185 'top_labels' => 0, 184 'top_labels' => 0,
185 'box'=>0, # pair location of boxed element
186 'allow_unknown_options'=> 1); 186 'allow_unknown_options'=> 1);
187 187
188 my ($numRows, $numCols, @myRows); 188 my ($numRows, $numCols, @myRows);
189 189
190 if (ref($ra_matrix) eq 'Matrix' ) { 190 if (ref($ra_matrix) eq 'Matrix' ) {
191 ($numRows, $numCols) = $ra_matrix->dim(); 191 ($numRows, $numCols) = $ra_matrix->dim();
192 for( my $i=0; $i<$numRows; $i++) { 192 for( my $i=0; $i<$numRows; $i++) {
195 my $entry = $ra_matrix->element($i+1,$j+1); 195 my $entry = $ra_matrix->element($i+1,$j+1);
196 $entry = "#" unless defined($entry); 196 $entry = "#" unless defined($entry);
197 push @{ $myRows[$i] }, $entry; 197 push @{ $myRows[$i] }, $entry;
198 } 198 }
199 } 199 }
200 } else { # matrix is input at [ [1,2,3],[4,5,6]] 200 } else { # matrix is input as [ [1,2,3],[4,5,6]]
201 $numCols = 0; 201 $numCols = 0;
202 @myRows = @{$ra_matrix}; 202 @myRows = @{$ra_matrix};
203 $numRows = scalar(@myRows); # counts horizontal rules too 203 $numRows = scalar(@myRows); # counts horizontal rules too
204 my $tmp; 204 my $tmp;
205 for $tmp (@myRows) { 205 for $tmp (@myRows) {
208 $numCols= scalar(@arow); #number of columns in table 208 $numCols= scalar(@arow); #number of columns in table
209 last; 209 last;
210 } 210 }
211 } 211 }
212 } 212 }
213 my ($boxrow,$boxcol) = (-1,-1); #default to impossible values so nothing is boxed
214 if($opts{'box'}) {
215 $boxrow = $opts{'box'}->[0];
216 $boxcol = $opts{'box'}->[1];
217 }
218
219
213 my $out; 220 my $out;
214 my $j; 221 my $j;
215 my $alignString=''; # alignment as a string for dvi/pdf 222 my $alignString=''; # alignment as a string for dvi/pdf
216 my $alignList; # alignment as a list 223 my $alignList; # alignment as a list
217 224
224 } else { 231 } else {
225 for($j=0; $j<$numCols; $j++) { 232 for($j=0; $j<$numCols; $j++) {
226 $alignList->[$j] = "c"; 233 $alignList->[$j] = "c";
227 $alignString .= "c"; 234 $alignString .= "c";
228 } 235 }
236 }
237 # Before we start, we cannot let top_labels proceed if we
238 # are in tth mode and force_tex is true since tth can't handle
239 # the resulting code
240 if($opts{'force_tex'} and $main::displayMode eq 'HTML_tth') {
241 $opts{'top_labels'} = 0;
229 } 242 }
230 243
231 $out .= dm_begin_matrix($alignString, %opts); 244 $out .= dm_begin_matrix($alignString, %opts);
232 # column labels for linear programming 245 # column labels for linear programming
233 $out .= dm_special_tops(%opts) if ($opts{'top_labels'}); 246 $out .= dm_special_tops(%opts) if ($opts{'top_labels'});
267 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 280 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
268 or $main::displayMode eq 'HTML_dpng' 281 or $main::displayMode eq 'HTML_dpng'
269 or $main::displayMode eq 'HTML_img') { 282 or $main::displayMode eq 'HTML_img') {
270 $out .= qq!<TABLE BORDER="0" Cellspacing="8">\n!; 283 $out .= qq!<TABLE BORDER="0" Cellspacing="8">\n!;
271 } 284 }
272 else { 285 else {
273 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; 286 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
274 } 287 }
275 $out; 288 $out;
276} 289}
277 290
284 my ($brh, $erh) = ("",""); # Start and end raw html 297 my ($brh, $erh) = ("",""); # Start and end raw html
285 if($main::displayMode eq 'Latex2HTML') { 298 if($main::displayMode eq 'Latex2HTML') {
286 $brh = "\\begin{rawhtml}"; 299 $brh = "\\begin{rawhtml}";
287 $erh = "\\end{rawhtml}"; 300 $erh = "\\end{rawhtml}";
288 } 301 }
289 302
290 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 303 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
291 for $j (@top_labels) { 304 for $j (@top_labels) {
292 $out .= '\smash{\raisebox{2.9ex}{\ensuremath{'. 305 $out .= '\smash{\raisebox{2.9ex}{\ensuremath{'.
293 $j . '}}} &'; 306 $j . '}}} &';
294 } 307 }
347 if($main::displayMode eq 'Latex2HTML') { 360 if($main::displayMode eq 'Latex2HTML') {
348 $brh = "\\begin{rawhtml}"; 361 $brh = "\\begin{rawhtml}";
349 $erh = "\\end{rawhtml}"; 362 $erh = "\\end{rawhtml}";
350 } 363 }
351 364
352 365
353 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 366 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
354 return ""; 367 return "";
355 } 368 }
356 369
357 if($main::displayMode eq 'HTML_dpng' 370 if($main::displayMode eq 'HTML_dpng'
358 or $main::displayMode eq 'Latex2HTML' 371 or $main::displayMode eq 'Latex2HTML'
359 or $main::displayMode eq 'HTML_dpng') { 372 or $main::displayMode eq 'HTML_dpng') {
360 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh"; 373 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh";
361 374
362 $out.= dm_image_delimeter($numrows, $opts{'right'}); 375 $out.= dm_image_delimeter($numrows, $opts{'right'});
363 return $out; 376 return $out;
364 } 377 }
365 378
366# $out .= "</table>"; 379# $out .= "</table>";
370 return $out; 383 return $out;
371} 384}
372 385
373sub dm_end_matrix { 386sub dm_end_matrix {
374 my %opts = @_; 387 my %opts = @_;
375 388
376 my $out = ""; 389 my $out = "";
377 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 390 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
378 $out .= "\\end{array}\\right$opts{right}"; 391 $out .= "\\end{array}\\right$opts{right}";
379 $out .= $opts{'force_tex'} ? '' : "\\) "; 392 $out .= $opts{'force_tex'} ? '' : "\\) ";
380 if($opts{'top_labels'}) { 393 if($opts{'top_labels'}) {
471 } else { 484 } else {
472 # Making a hline in a table 485 # Making a hline in a table
473 return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>'; 486 return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>';
474 } 487 }
475 } 488 }
476 489
477 my @elements = @{$elements}; 490 my @elements = @{$elements};
478 my $out = ""; 491 my $out = "";
479 my ($brh, $erh) = ("",""); # Start and end raw html 492 my ($brh, $erh) = ("",""); # Start and end raw html
480 my $element; 493 my $element;
481 if($main::displayMode eq 'Latex2HTML') { 494 if($main::displayMode eq 'Latex2HTML') {
548 561
549 Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX 562 Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX
550 output; and valign which sets vertical alignment on web page output. 563 output; and valign which sets vertical alignment on web page output.
551 564
552=cut 565=cut
553 566
554sub mbox { 567sub mbox {
555 my $inList = shift; 568 my $inList = shift;
556 my %opts; 569 my %opts;
557 if(ref($inList) eq 'ARRAY') { 570 if(ref($inList) eq 'ARRAY') {
558 %opts = @_; 571 %opts = @_;
586 } 599 }
587 $out .= "$brh</table>$erh"; 600 $out .= "$brh</table>$erh";
588 } 601 }
589 return $out; 602 return $out;
590} 603}
591 604
592 605
593=head4 ra_flatten_matrix 606=head4 ra_flatten_matrix
594 607
595 Usage: ra_flatten_matrix($A) 608 Usage: ra_flatten_matrix($A)
596 609
597 where $A is a matrix object 610 where $A is a matrix object
598 The output is a reference to an array. The matrix is placed in the array by iterating 611 The output is a reference to an array. The matrix is placed in the array by iterating
599 over columns on the inside 612 over columns on the inside
600 loop, then over the rows. (e.g right to left and then down, as one reads text) 613 loop, then over the rows. (e.g right to left and then down, as one reads text)
601 614
615 } 628 }
616 \@array; 629 \@array;
617} 630}
618 631
619# This subroutine is probably obsolete and not generally useful. It was patterned after the APL 632# This subroutine is probably obsolete and not generally useful. It was patterned after the APL
620# constructs for multiplying matrices. It might come in handy for non-standard multiplication of 633# constructs for multiplying matrices. It might come in handy for non-standard multiplication of
621# of matrices (e.g. mod 2) for indice matrices. 634# of matrices (e.g. mod 2) for indice matrices.
622sub apl_matrix_mult{ 635sub apl_matrix_mult{
623 my $ra_a= shift; 636 my $ra_a= shift;
624 my $ra_b= shift; 637 my $ra_b= shift;
625 my %options = @_; 638 my %options = @_;
664 677
665 678
666=head5 answer_matrix 679=head5 answer_matrix
667 680
668 Usage \[ \{ answer_matrix(rows,columns,width_of_ans_rule, @options) \} \] 681 Usage \[ \{ answer_matrix(rows,columns,width_of_ans_rule, @options) \} \]
669 682
670 Creates an array of answer blanks and passes it to display_matrix which returns 683 Creates an array of answer blanks and passes it to display_matrix which returns
671 text which represents the matrix in TeX format used in math display mode. Answers 684 text which represents the matrix in TeX format used in math display mode. Answers
672 are then passed back to whatever answer evaluators you write at the end of the problem. 685 are then passed back to whatever answer evaluators you write at the end of the problem.
673 (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be 686 (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be
674 returned to the evaluaters starting in the top left hand corner and proceed to the left 687 returned to the evaluaters starting in the top left hand corner and proceed to the left
675 and then at the end moving down one row, just as you would read them.) 688 and then at the end moving down one row, just as you would read them.)
676 689
677 The options are passed on to display_matrix. 690 The options are passed on to display_matrix.
678 691
679 692
680=cut 693=cut
681 694
687 my @options = @_; 700 my @options = @_;
688 my @array=(); 701 my @array=();
689 for( my $i = 0; $i < $m; $i+=1) 702 for( my $i = 0; $i < $m; $i+=1)
690 { 703 {
691 my @row_array = (); 704 my @row_array = ();
692 705
693 for( my $i = 0; $i < $n; $i+=1) 706 for( my $i = 0; $i < $n; $i+=1)
694 { 707 {
695 push @row_array, ans_rule($width); 708 push @row_array, ans_rule($width);
696 } 709 }
697 my $r_row_array = \@row_array; 710 my $r_row_array = \@row_array;
698 push @array, $r_row_array; 711 push @array, $r_row_array;
699 } 712 }
700 display_matrix( \@array, @options ); 713 display_matrix( \@array, @options );
701 714
702} 715}
703 716
704# sub format_answer{ 717# sub format_answer{
705# my $ra_eigenvalues = shift; 718# my $ra_eigenvalues = shift;
706# my $ra_eigenvectors = shift; 719# my $ra_eigenvectors = shift;
707# my $functionName = shift; 720# my $functionName = shift;
708# my @eigenvalues=@$ra_eigenvalues; 721# my @eigenvalues=@$ra_eigenvalues;
729# $out; 742# $out;
730# } 743# }
731# sub format_question{ 744# sub format_question{
732# my $ra_matrix = shift; 745# my $ra_matrix = shift;
733# my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! 746# my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)!
734# 747#
735# } 748# }
736 749
7371; 7501;

Legend:
Removed from v.1080  
changed lines
  Added in v.1097

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9