Parent Directory
| 
Revision Log
Changed display_matrix to display_matrix_mm, added display_matrix_math_mode, and changed displaymat to display_matrix.
1 #!/usr/local/bin/webwork-perl 2 3 ########### 4 #use Carp; 5 6 =head1 NAME 7 8 Matrix macros for the PG language 9 10 =head1 SYNPOSIS 11 12 13 14 =head1 DESCRIPTION 15 16 Almost all of the macros in the file are very rough at best. The most useful is display_matrix. 17 Many of the other macros work with vectors and matrices stored as anonymous arrays. 18 19 Frequently it may be 20 more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there. 21 22 23 =cut 24 25 BEGIN { 26 be_strict(); 27 } 28 29 sub _PGmatrixmacros_init { 30 } 31 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 34 # actually used. 35 36 sub zero_check{ 37 my $array = shift; 38 my %options = @_; 39 my $num = @$array; 40 my $i; 41 my $max = 0; my $mm; 42 for ($i=0; $i< $num; $i++) { 43 $mm = $array->[$i] ; 44 $max = abs($mm) if abs($mm) > $max; 45 } 46 my $tol = $options{tol}; 47 $tol = 0.01*$options{reltol}*$options{avg} if defined($options{reltol}) and defined $options{avg}; 48 $tol = .000001 unless defined($tol); 49 ($max <$tol) ? 1: 0; # 1 if the array is close to zero; 50 } 51 sub vec_dot{ 52 my $vec1 = shift; 53 my $vec2 = shift; 54 warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. 55 my @vec1=@$vec1; 56 my @vec2=@$vec2; 57 my $sum = 0; 58 59 while(@vec1) { 60 $sum += shift(@vec1)*shift(@vec2); 61 } 62 $sum; 63 } 64 sub proj_vec { 65 my $vec = shift; 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 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]; 70 $matrix * transpose($matrix) * $vec; 71 } 72 73 sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector 74 my $correct_vector = shift; 75 my %options = @_; 76 my $ans_eval = sub { 77 my $in = shift @_; 78 79 my $ans_hash = new AnswerHash; 80 my @in = split("\0",$in); 81 my @correct_vector=@$correct_vector; 82 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 83 $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; 84 85 return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension 86 87 my $correct_length = vec_dot($correct_vector,$correct_vector); 88 my $in_length = vec_dot(\@in,\@in); 89 return($ans_hash) if $in_length == 0; 90 91 if (defined($correct_length) and $correct_length != 0) { 92 my $constant = vec_dot($correct_vector,\@in)/$correct_length; 93 my @difference = (); 94 for(my $i=0; $i < @correct_vector; $i++ ) { 95 $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; 96 } 97 $ans_hash->{score} = zero_check(\@difference); 98 99 } else { 100 $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; 101 } 102 $ans_hash; 103 104 }; 105 106 $ans_eval; 107 } 108 109 ############ 110 111 =head4 display_matrix 112 113 Usage \[ \{ display_matrix($A) \} \] 114 \[ \{ display_matrix([ [ 1, 3], [4, 6] ]) \} \] 115 116 Output is text which represents the matrix in TeX format used in math display mode. 117 118 119 =cut 120 121 122 sub display_matrix_mm{ # will display a matrix in tex format. 123 # the matrix can be either of type array or type 'Matrix' 124 # my $ra_matrix = shift; 125 # my $out=''; 126 # if (ref($ra_matrix) eq 'Matrix' ) { 127 # my ($rows, $cols) = $ra_matrix->dim(); 128 # $out = q!\\left(\\begin{array}{! . 'c'x$cols . q!}!; 129 # for( my $i=1; $i<=$rows; $i++) { 130 # for (my $j=1; $j<=$cols; $j++) { 131 # my $entry = $ra_matrix->element($i,$j); 132 # $entry = "#" unless defined($entry); 133 # $out.= $entry; 134 # $out .= ($j < $cols) ? ' & ' : "\\cr\n"; 135 # } 136 # } 137 # $out .= "\\end{array}\\right)"; 138 # } elsif( ref($ra_matrix) eq 'ARRAY') { 139 # my $rows = @$ra_matrix; 140 # my $cols = @{$ra_matrix->[0]}; 141 # $out = q!\\left(\\begin{array}{! . 'c' x$cols . q!}!; 142 # for(my $i=0; $i<$rows; $i++) { 143 # my @row = @{$ra_matrix->[$i]}; 144 # while (@row) { 145 # my $entry = shift(@row); 146 # $entry = "#" unless defined($entry); 147 # $out.= $entry; 148 # if (@row) { 149 # $out .= "& "; 150 # } else { 151 # next; 152 # } 153 # } 154 # $out .= "\\cr\n"; 155 # } 156 # $out .= "\\end{array}\\right)"; 157 # } else { 158 # warn "The input" . ref($ra_matrix) . " doesn't make sense as input to display_matrix. "; 159 # } 160 # $out; 161 162 return display_matrix(@_, 'force_tex'=>1); 163 } 164 165 sub display_matrix_math_mode { 166 return display_matrix_mm(@_); 167 } 168 169 sub display_matrix { 170 my $ra_matrix = shift; 171 my %opts = @_; 172 set_default_options(\%opts, 173 '_filter_name' => 'displaymat', 174 'force_tex' => 0, 175 'allow_unknown_options'=> 1); 176 177 my ($numRows, $numCols, @myRows); 178 179 if (ref($ra_matrix) eq 'Matrix' ) { 180 ($numRows, $numCols) = $ra_matrix->dim(); 181 for( my $i=0; $i<$numRows; $i++) { 182 $myRows[$i] = []; 183 for (my $j=0; $j<$numCols; $j++) { 184 my $entry = $ra_matrix->element($i+1,$j+1); 185 $entry = "#" unless defined($entry); 186 push @{ $myRows[$i] }, $entry; 187 } 188 } 189 } else { # matrix is input at [ [1,2,3],[4,5,6]] 190 @myRows = @{$ra_matrix}; 191 $numRows = scalar(@myRows); 192 my @arow = @{$myRows[0]}; 193 $numCols= scalar(@arow); #number of columns in table 194 } 195 my $out; 196 my $j; 197 my $alignString=''; # alignment as a string for dvi/pdf 198 my $alignList; # alignment as a list 199 200 if(defined($opts{'align'})) { 201 $alignString= $opts{'align'}; 202 $alignString =~ tr/s/|/; # Treat "s" as "|" 203 @$alignList = split //, $opts{'align'}; 204 } else { 205 for($j=0; $j<$numCols; $j++) { 206 $alignList->[$j] = "c"; 207 $alignString .= "c"; 208 } 209 } 210 211 $out .= dm_begin_matrix($alignString, %opts); 212 $out .= dm_mat_left($numRows, %opts); 213 for $j (@myRows) { 214 $out .= dm_mat_row($j, $alignList, %opts); 215 } 216 $out .= dm_mat_right($numRows, %opts); 217 $out .= dm_end_matrix(%opts); 218 $out; 219 } 220 221 sub dm_begin_matrix { 222 my ($aligns)=shift; #alignments of columns in table 223 my %opts = @_; 224 my $out = ""; 225 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 226 $out .= "\n"; 227 $out .= $opts{'force_tex'} ? '' : '\('; 228 $out .= "\\displaystyle\\left(\\begin{array}{$aligns} \n"; 229 } 230 elsif ($main::displayMode eq 'Latex2HTML') { 231 $out .= "\n\\begin{rawhtml} <TABLE BORDER=0>\n\\end{rawhtml}"; 232 } 233 elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng') { 234 $out .= "<TABLE BORDER=0>\n" 235 } 236 else { 237 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; 238 } 239 $out; 240 } 241 242 243 sub dm_mat_left { 244 my $numrows = shift; 245 my %opts = @_; 246 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 247 return ""; 248 } 249 my $out=''; 250 my $j; 251 252 if(($main::displayMode eq 'HTML_dpng') || ($main::displayMode eq 'Latex2HTML')) { 253 # if($numrows>12) { $numrows = 12; } 254 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 255 $out .= "<tr><td nowrap=\"nowrap\" align=\"left\">"; 256 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 257 # $out .= "<img alt=\"(\" src = \"". 258 # $main::imagesURL."/left$numrows.png\" >"; 259 # return $out; 260 $out .= '\(\left.\begin{array}{c}'; 261 for($j=0;$j<$numrows;$j++) { $out .= ' \\\\'; } 262 $out .= '\end{array}\right(\)'; 263 264 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 265 $out .= "<td><table border=0 cellspacing=5>\n"; 266 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 267 return $out; 268 } 269 # Mode is now tth 270 $out = "<tr><td nowrap=\"nowrap\" align=\"left\"><font face=\"symbol\">æ<br />"; 271 for($j=0;$j<$numrows;$j++) { 272 $out .= "ç<br />"; 273 } 274 $out .= "è</font></td>\n"; 275 $out .= "<td><table border=0 cellspacing=5>\n"; 276 return $out; 277 } 278 279 sub dm_mat_right { 280 my $numrows = shift; 281 my %opts = @_; 282 my $out=''; 283 my $j; 284 285 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 286 return ""; 287 } 288 289 if(($main::displayMode eq 'HTML_dpng') || ($main::displayMode eq 'Latex2HTML')) { 290 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 291 $out .= "</table><td nowrap=\"nowrap\" align=\"right\">"; 292 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 293 294 # $out .= "<img alt=\"(\" src = \"". 295 # "/webwork_system_html/images"."/right$numrows.png\" >"; 296 $out .= '\(\left)\begin{array}{c}'; 297 for($j=0;$j<$numrows;$j++) { $out .= ' \\\\'; } 298 $out .= '\end{array}\right.\)'; 299 return $out; 300 } 301 302 $out .= "</table>"; 303 $out .= "<td nowrap=\"nowrap\" align=\"left\"><font face=\"symbol\">ö<br />"; 304 for($j=0;$j<$numrows;$j++) { 305 $out .= "÷<br />"; 306 } 307 $out .= "ø</font></td>\n"; 308 return $out; 309 } 310 311 sub dm_end_matrix { 312 my %opts = @_; 313 314 my $out = ""; 315 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 316 $out .= "\n\\end{array}\\right)"; 317 $out .= $opts{'force_tex'} ? '' : "\\)\n"; 318 } 319 elsif ($main::displayMode eq 'Latex2HTML') { 320 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}"; 321 } 322 elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng') { 323 $out .= "</TABLE>\n"; 324 } 325 else { 326 $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n"; 327 } 328 $out; 329 } 330 331 332 sub dm_mat_row { 333 my $elements = shift; 334 my $tmp = shift; 335 my @align = @{$tmp} ; 336 my %opts = @_; 337 my @elements = @{$elements}; 338 my $out = ""; 339 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 340 while (@elements) { 341 $out .= shift(@elements) . " &"; 342 } 343 chop($out); # remove last & 344 $out .= "\\cr \n"; 345 # carriage returns must be added manually for tex 346 } 347 elsif ($main::displayMode eq 'Latex2HTML') { 348 $out .= "\n\\begin{rawhtml}\n<TR>\n\\end{rawhtml}\n"; 349 while (@elements) { 350 $out .= " \n\\begin{rawhtml}\n<TD> \n\\end{rawhtml}\n" . shift(@elements) . " \n\\begin{rawhtml}\n</TD> \n\\end{rawhtml}\n"; 351 } 352 $out .= " \n\\begin{rawhtml}\n</TR> \n\\end{rawhtml}\n"; 353 } 354 elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng') { 355 $out .= "<TR><td nowrap=\"nowrap\">\n"; 356 while (@elements) { 357 my $myalign; 358 #do {$myalign = shift @align;} until($myalign ne "|"); 359 $myalign = shift @align; 360 if($myalign eq "|") { 361 $out .= '<td> | </td>'; 362 } else { 363 if($myalign eq "c") { $myalign = "center";} 364 if($myalign eq "l") { $myalign = "left";} 365 if($myalign eq "r") { $myalign = "right";} 366 $out .= "<TD nowrap=\"nowrap\" align=\"$myalign\">" . shift(@elements) . "</TD>"; 367 } 368 } 369 $out .= "<td>\n</TR>\n"; 370 } 371 else { 372 $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n"; 373 } 374 $out; 375 } 376 377 378 379 =head4 ra_flatten_matrix 380 381 Usage: ra_flatten_matrix($A) 382 383 where $A is a matrix object 384 The output is a reference to an array. The matrix is placed in the array by iterating 385 over columns on the inside 386 loop, then over the rows. (e.g right to left and then down, as one reads text) 387 388 389 =cut 390 391 392 sub ra_flatten_matrix{ 393 my $matrix = shift; 394 warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/; 395 my @array = (); 396 my ($rows, $cols ) = $matrix->dim(); 397 foreach my $i (1..$rows) { 398 foreach my $j (1..$cols) { 399 push(@array, $matrix->element($i,$j) ); 400 } 401 } 402 \@array; 403 } 404 405 # This subroutine is probably obsolete and not generally useful. It was patterned after the APL 406 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of 407 # of matrices (e.g. mod 2) for indice matrices. 408 sub apl_matrix_mult{ 409 my $ra_a= shift; 410 my $ra_b= shift; 411 my %options = @_; 412 my $rf_op_times= sub {$_[0] *$_[1]}; 413 my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; }; 414 $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE'; 415 $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE'; 416 my $rows = @$ra_a; 417 my $cols = @{$ra_b->[0]}; 418 my $k_size = @$ra_b; 419 my $out ; 420 my ($i, $j, $k); 421 for($i=0;$i<$rows;$i++) { 422 for($j=0;$j<$cols;$j++) { 423 my @r = (); 424 for($k=0;$k<$k_size;$k++) { 425 $r[$k] = &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]); 426 } 427 $out->[$i]->[$j] = &$rf_op_plus( @r ); 428 } 429 } 430 $out; 431 } 432 433 sub matrix_mult { 434 apl_matrix_mult($_[0], $_[1]); 435 } 436 437 sub make_matrix{ 438 my $function = shift; 439 my $rows = shift; 440 my $cols = shift; 441 my ($i, $j, $k); 442 my $ra_out; 443 for($i=0;$i<$rows;$i++) { 444 for($j=0;$j<$cols;$j++) { 445 $ra_out->[$i]->[$j] = &$function($i,$j); 446 } 447 } 448 $ra_out; 449 } 450 451 452 # sub format_answer{ 453 # my $ra_eigenvalues = shift; 454 # my $ra_eigenvectors = shift; 455 # my $functionName = shift; 456 # my @eigenvalues=@$ra_eigenvalues; 457 # my $size= @eigenvalues; 458 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 459 # my $out = qq! 460 # $functionName(t) =! . 461 # displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen, 462 # 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''}, 463 # 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } 464 # ) ) ; 465 # $out; 466 # } 467 # sub format_vector_answer{ 468 # my $ra_eigenvalues = shift; 469 # my $ra_eigenvectors = shift; 470 # my $functionName = shift; 471 # my @eigenvalues=@$ra_eigenvalues; 472 # my $size= @eigenvalues; 473 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 474 # my $out = qq! 475 # $functionName(t) =! . 476 # displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ; 477 # $out; 478 # } 479 # sub format_question{ 480 # my $ra_matrix = shift; 481 # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! 482 # 483 # } 484 485 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |