Parent Directory
| 
Revision Log
Bug fix in mbox for l2h mode, vertical bars in matricies starting to work in all modes.
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 # Maybe this will become a global variable? 173 my $styleParams = defined($main::defaultDisplayMatrixStyle) ? 174 $main::defaultDisplayMatrixStyle : "(s)"; 175 176 set_default_options(\%opts, 177 '_filter_name' => 'displaymat', 178 'force_tex' => 0, 179 'left' => substr($styleParams,0,1), 180 'right' => substr($styleParams,2,1), 181 'midrule' => substr($styleParams,1,1), 182 'allow_unknown_options'=> 1); 183 184 my ($numRows, $numCols, @myRows); 185 186 if (ref($ra_matrix) eq 'Matrix' ) { 187 ($numRows, $numCols) = $ra_matrix->dim(); 188 for( my $i=0; $i<$numRows; $i++) { 189 $myRows[$i] = []; 190 for (my $j=0; $j<$numCols; $j++) { 191 my $entry = $ra_matrix->element($i+1,$j+1); 192 $entry = "#" unless defined($entry); 193 push @{ $myRows[$i] }, $entry; 194 } 195 } 196 } else { # matrix is input at [ [1,2,3],[4,5,6]] 197 $numCols = 0; 198 @myRows = @{$ra_matrix}; 199 $numRows = scalar(@myRows); # counts horizontal rules too 200 my $tmp; 201 for $tmp (@myRows) { 202 if($tmp ne 'hline') { 203 my @arow = @{$tmp}; 204 $numCols= scalar(@arow); #number of columns in table 205 last; 206 } 207 } 208 } 209 my $out; 210 my $j; 211 my $alignString=''; # alignment as a string for dvi/pdf 212 my $alignList; # alignment as a list 213 214 if(defined($opts{'align'})) { 215 $alignString= $opts{'align'}; 216 $alignString =~ s/v/$opts{'midrule'}/g; 217 $alignString =~ tr/s/|/; # Treat "s" as "|" 218 $alignString =~ tr/n//; # Remove "n" altogether 219 $alignString =~ tr/d/|/; # Temporary because we don't support dashed yet 220 @$alignList = split //, $alignString; 221 } else { 222 for($j=0; $j<$numCols; $j++) { 223 $alignList->[$j] = "c"; 224 $alignString .= "c"; 225 } 226 } 227 228 $out .= dm_begin_matrix($alignString, %opts); 229 $out .= dm_mat_left($numRows, %opts); 230 # vertical lines put in with first row 231 $j = shift @myRows; 232 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows); 233 for $j (@myRows) { 234 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>0); 235 } 236 $out .= dm_mat_right($numRows, %opts); 237 $out .= dm_end_matrix(%opts); 238 $out; 239 } 240 241 sub dm_begin_matrix { 242 my ($aligns)=shift; #alignments of columns in table 243 my %opts = @_; 244 my $out = ""; 245 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 246 # $out .= "\n"; 247 $out .= $opts{'force_tex'} ? '' : '\('; 248 $out .= '\displaystyle\left'.$opts{'left'}."\\begin{array}{$aligns} \n"; 249 } 250 elsif ($main::displayMode eq 'Latex2HTML') { 251 $out .= "\n\\begin{rawhtml} <TABLE BORDER=0>\n\\end{rawhtml}"; 252 } 253 elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng') { 254 $out .= "<TABLE BORDER=0>\n" 255 } 256 else { 257 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; 258 } 259 $out; 260 } 261 262 263 sub dm_mat_left { 264 my $numrows = shift; 265 my %opts = @_; 266 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 267 return ""; 268 } 269 my $out=''; 270 my $j; 271 272 if(($main::displayMode eq 'HTML_dpng') || ($main::displayMode eq 'Latex2HTML')) { 273 # if($numrows>12) { $numrows = 12; } 274 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 275 $out .= "<tr><td nowrap=\"nowrap\" align=\"left\">"; 276 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 277 # $out .= "<img alt=\"(\" src = \"". 278 # $main::imagesURL."/left$numrows.png\" >"; 279 # return $out; 280 $out .= dm_image_delimeter($numrows, $opts{'left'}); 281 282 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 283 $out .= "<td><table border=0 cellspacing=5>\n"; 284 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 285 return $out; 286 } 287 # Mode is now tth 288 289 $out .= dm_tth_delimeter($numrows, $opts{'left'}); 290 $out .= "<td><table border=0 cellspacing=5>\n"; 291 return $out; 292 } 293 294 sub dm_mat_right { 295 my $numrows = shift; 296 my %opts = @_; 297 my $out=''; 298 my $j; 299 300 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 301 return ""; 302 } 303 304 if(($main::displayMode eq 'HTML_dpng') || ($main::displayMode eq 'Latex2HTML')) { 305 if($main::displayMode eq 'Latex2HTML') { $out .= '\begin{rawhtml}'; } 306 $out .= "</table><td nowrap=\"nowrap\" align=\"right\">"; 307 if($main::displayMode eq 'Latex2HTML') { $out .= '\end{rawhtml}'; } 308 309 # $out .= "<img alt=\"(\" src = \"". 310 # "/webwork_system_html/images"."/right$numrows.png\" >"; 311 $out.= dm_image_delimeter($numrows, $opts{'right'}); 312 return $out; 313 } 314 315 $out .= "</table>"; 316 317 $out .= dm_tth_delimeter($numrows, $opts{'right'}); 318 return $out; 319 } 320 321 sub dm_end_matrix { 322 my %opts = @_; 323 324 my $out = ""; 325 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 326 $out .= "\n\\end{array}\\right$opts{right}"; 327 $out .= $opts{'force_tex'} ? '' : "\\) "; 328 } 329 elsif ($main::displayMode eq 'Latex2HTML') { 330 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}"; 331 } 332 elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' || $main::displayMode eq 'HTML_dpng') { 333 $out .= "</TABLE>\n"; 334 } 335 else { 336 $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n"; 337 } 338 $out; 339 } 340 341 sub dm_image_delimeter { 342 my $numRows = shift; 343 my $char = shift; 344 my ($out, $j); 345 346 if($char eq ".") {return("");} 347 if($char eq "{") {$char = '\lbrace';} 348 if($char eq "}") {$char = '\rbrace';} 349 $out .= '\(\left.\begin{array}{c}'; 350 for($j=0;$j<=$numRows;$j++) { $out .= ' \\\\'; } 351 $out .= '\end{array}\right'.$char.'\)'; 352 return($out); 353 } 354 355 sub dm_tth_delimeter { 356 my $numRows = shift; 357 my $char = shift; 358 359 if($char eq ".") { return("");} 360 my ($top, $mid, $bot, $extra); 361 my ($j, $out); 362 363 if($char eq "(") { ($top, $mid, $bot, $extra) = ('æ','ç','è','ç');} 364 elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('ö','÷','ø','÷');} 365 elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('ê','ê','ê','ê');} 366 elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('é','ê','ë','ê');} 367 elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('ù','ú','û','ú');} 368 elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('ì','ï','î','í');} 369 elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('ü','ï','þ','ý');} 370 else { warn "Unknown delimiter in dm_tth_delimeter";} 371 372 $out = '<td nowrap="nowrap" align="left"><font face="symbol">'; 373 $out .= "$top<br />"; 374 for($j=1;$j<$numRows; $j++) { 375 $out .= "$mid<br />"; 376 } 377 $out .= "$extra<br />"; 378 for($j=1;$j<$numRows; $j++) { 379 $out .= "$mid<br />"; 380 } 381 $out .= "$bot</font></td>\n"; 382 return $out; 383 } 384 385 sub dm_mat_row { 386 my $elements = shift; 387 my $tmp = shift; 388 my @align = @{$tmp} ; 389 my %opts = @_; 390 my @elements = @{$elements}; 391 my $out = ""; 392 my ($brh, $erh) = ("",""); # Start and end raw html 393 if($main::displayMode eq 'Latex2HTML') { 394 $brh = " \n\\begin{rawhtml}\n"; 395 $erh = " \n\\end{rawhtml}\n"; 396 } 397 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 398 while (@elements) { 399 $out .= shift(@elements) . " &"; 400 } 401 chop($out); # remove last & 402 $out .= "\\cr \n"; 403 # carriage returns must be added manually for tex 404 } elsif ($main::displayMode eq 'HTML' || $main::displayMode eq 'HTML_tth' 405 || $main::displayMode eq 'HTML_dpng' 406 || $main::displayMode eq 'Latex2HTML') { 407 $out .= "$brh<TR><td nowrap=\"nowrap\">\n$erh"; 408 while (@elements) { 409 my $myalign; 410 $myalign = shift @align; 411 if($myalign eq "|") { 412 if($opts{'isfirst'} && $main::displayMode ne 'HTML_tth') { 413 $out .= $brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh; 414 $out .= dm_image_delimeter($opts{'isfirst'}, "|"); 415 } elsif($main::displayMode eq 'HTML_tth') { 416 $out .= '<td> | </td>'; 417 } 418 } else { 419 if($myalign eq "c") { $myalign = "center";} 420 if($myalign eq "l") { $myalign = "left";} 421 if($myalign eq "r") { $myalign = "right";} 422 $out .= "$brh<TD nowrap=\"nowrap\" align=\"$myalign\">$erh" . shift(@elements) . "$brh</TD>$erh"; 423 } 424 } 425 $out .= "$brh<td>\n</TR>\n$erh"; 426 } 427 else { 428 $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n"; 429 } 430 $out; 431 } 432 433 sub mbox { 434 my $inList = shift; 435 my %opts = @_; 436 437 set_default_options(\%opts, 438 '_filter_name' => 'mbox', 439 'valign' => 'middle', 440 'allowbreaks' => 'no', 441 'allow_unknown_options'=> 0); 442 my $out = ""; 443 my $j; 444 my $l2h = ($main::displayMode eq 'Latex2HTML') ? 1 : 0; 445 my @hlist = @{$inList}; 446 if($main::displayMode eq 'TeX') { 447 for $j (@hlist) { $out .= $j;} 448 } else { 449 $out .= $l2h ? "\n\\begin{rawhtml}\n" : ''; 450 $out .= qq!<table><tr valign="$opts{'valign'}">!; 451 $out .= $l2h ? "\n\\end{rawhtml}\n" : ''; 452 for $j (@hlist) { 453 $out .= $l2h ? "\n\\begin{rawhtml}\n<td>\n\\end{rawhtml}\n" : "<td>"; 454 $out .= "$j"; 455 $out .= $l2h ? "\n\\begin{rawhtml}\n</td>\n\\end{rawhtml}\n" : "</td>"; 456 } 457 $out .= $l2h ? "\n\\begin{rawhtml}\n" : ''; 458 $out .= "</table>"; 459 $out .= $l2h ? "\n\\end{rawhtml}\n" : ''; 460 } 461 return $out; 462 } 463 464 465 =head4 ra_flatten_matrix 466 467 Usage: ra_flatten_matrix($A) 468 469 where $A is a matrix object 470 The output is a reference to an array. The matrix is placed in the array by iterating 471 over columns on the inside 472 loop, then over the rows. (e.g right to left and then down, as one reads text) 473 474 475 =cut 476 477 478 sub ra_flatten_matrix{ 479 my $matrix = shift; 480 warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/; 481 my @array = (); 482 my ($rows, $cols ) = $matrix->dim(); 483 foreach my $i (1..$rows) { 484 foreach my $j (1..$cols) { 485 push(@array, $matrix->element($i,$j) ); 486 } 487 } 488 \@array; 489 } 490 491 # This subroutine is probably obsolete and not generally useful. It was patterned after the APL 492 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of 493 # of matrices (e.g. mod 2) for indice matrices. 494 sub apl_matrix_mult{ 495 my $ra_a= shift; 496 my $ra_b= shift; 497 my %options = @_; 498 my $rf_op_times= sub {$_[0] *$_[1]}; 499 my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; }; 500 $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE'; 501 $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE'; 502 my $rows = @$ra_a; 503 my $cols = @{$ra_b->[0]}; 504 my $k_size = @$ra_b; 505 my $out ; 506 my ($i, $j, $k); 507 for($i=0;$i<$rows;$i++) { 508 for($j=0;$j<$cols;$j++) { 509 my @r = (); 510 for($k=0;$k<$k_size;$k++) { 511 $r[$k] = &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]); 512 } 513 $out->[$i]->[$j] = &$rf_op_plus( @r ); 514 } 515 } 516 $out; 517 } 518 519 sub matrix_mult { 520 apl_matrix_mult($_[0], $_[1]); 521 } 522 523 sub make_matrix{ 524 my $function = shift; 525 my $rows = shift; 526 my $cols = shift; 527 my ($i, $j, $k); 528 my $ra_out; 529 for($i=0;$i<$rows;$i++) { 530 for($j=0;$j<$cols;$j++) { 531 $ra_out->[$i]->[$j] = &$function($i,$j); 532 } 533 } 534 $ra_out; 535 } 536 537 538 # sub format_answer{ 539 # my $ra_eigenvalues = shift; 540 # my $ra_eigenvectors = shift; 541 # my $functionName = shift; 542 # my @eigenvalues=@$ra_eigenvalues; 543 # my $size= @eigenvalues; 544 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 545 # my $out = qq! 546 # $functionName(t) =! . 547 # displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen, 548 # 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''}, 549 # 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } 550 # ) ) ; 551 # $out; 552 # } 553 # sub format_vector_answer{ 554 # my $ra_eigenvalues = shift; 555 # my $ra_eigenvectors = shift; 556 # my $functionName = shift; 557 # my @eigenvalues=@$ra_eigenvalues; 558 # my $size= @eigenvalues; 559 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 560 # my $out = qq! 561 # $functionName(t) =! . 562 # displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ; 563 # $out; 564 # } 565 # sub format_question{ 566 # my $ra_matrix = shift; 567 # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! 568 # 569 # } 570 571 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |