Parent Directory
| 
Revision Log
Adding a newer version of PGmatrixmacros.pl --Mike
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( [ [1, '\(\sin x\)'], [ans_rule(5), 6] ]) \} 114 \{ display_matrix($A, align=>'crvl') \} 115 \[ \{ display_matrix_mm($A) \} \] 116 \[ \{ display_matrix_mm([ [1, 3], [4, 6] ]) \} \] 117 118 display_matrix produces a matrix for display purposes. It checks whether 119 it is producing LaTeX output, or if it is displaying on a web page in one 120 of the various modes. The input can either be of type Matrix, or a 121 reference to an array. 122 123 Entries can be numbers, Fraction objects, bits of math mode, or answer 124 boxes. An entire row can be replaced by the string 'hline' to produce 125 a horizontal line in the matrix. 126 127 display_matrix_mm functions similarly, except that it should be inside 128 math mode. display_matrix_mm cannot contain answer boxes in its entries. 129 Entries to display_matrix_mm should assume that they are already in 130 math mode. 131 132 Both functions take an optional alignment string, similar to ones in 133 LaTeX tabulars and arrays. Here c for centered columns, l for left 134 flushed columns, and r for right flushed columns. 135 136 The alignment string can also specify vertical rules to be placed in the 137 matrix. Here s or | denote a solid line, d is a dashed line, and v 138 requests the default vertical line. This can be set on a system-wide 139 or course-wide basis via the variable $defaultDisplayMatrixStyle, and 140 it can default to solid, dashed, or no vertical line (n for none). 141 142 The matrix has left and right delimiters also specified by 143 $defaultDisplayMatrixStyle. They can be parentheses, square brackets, 144 braces, vertical bars, or none. The default can be overridden in 145 an individual problem with optional arguments such as left=>"|", or 146 right=>"]". 147 148 You can specify an optional argument of 'top_labels'=> ['a', 'b', 'c']. 149 These are placed above the columns of the matrix (as is typical for 150 linear programming tableaux, for example. The entries will be typeset 151 in math mode. 152 153 Top labels require a bit of care. For image modes, they look better 154 with display_matrix_mm where it is all one big image, but they work with 155 display_matrix. With tth, you pretty much have to use display_matrix 156 since tth can't handle the TeX tricks used to get the column headers 157 up there if it gets the whole matrix at once. 158 159 160 =cut 161 162 163 sub display_matrix_mm{ # will display a matrix in tex format. 164 # the matrix can be either of type array or type 'Matrix' 165 return display_matrix(@_, 'force_tex'=>1); 166 } 167 168 sub display_matrix_math_mode { 169 return display_matrix_mm(@_); 170 } 171 172 sub display_matrix { 173 my $ra_matrix = shift; 174 my %opts = @_; 175 # Now a global variable? 176 my $styleParams = defined($main::defaultDisplayMatrixStyle) ? 177 $main::defaultDisplayMatrixStyle : "(s)"; 178 179 set_default_options(\%opts, 180 '_filter_name' => 'display_matrix', 181 'force_tex' => 0, 182 'left' => substr($styleParams,0,1), 183 'right' => substr($styleParams,2,1), 184 'midrule' => substr($styleParams,1,1), 185 'top_labels' => 0, 186 'allow_unknown_options'=> 1); 187 188 my ($numRows, $numCols, @myRows); 189 190 if (ref($ra_matrix) eq 'Matrix' ) { 191 ($numRows, $numCols) = $ra_matrix->dim(); 192 for( my $i=0; $i<$numRows; $i++) { 193 $myRows[$i] = []; 194 for (my $j=0; $j<$numCols; $j++) { 195 my $entry = $ra_matrix->element($i+1,$j+1); 196 $entry = "#" unless defined($entry); 197 push @{ $myRows[$i] }, $entry; 198 } 199 } 200 } else { # matrix is input at [ [1,2,3],[4,5,6]] 201 $numCols = 0; 202 @myRows = @{$ra_matrix}; 203 $numRows = scalar(@myRows); # counts horizontal rules too 204 my $tmp; 205 for $tmp (@myRows) { 206 if($tmp ne 'hline') { 207 my @arow = @{$tmp}; 208 $numCols= scalar(@arow); #number of columns in table 209 last; 210 } 211 } 212 } 213 my $out; 214 my $j; 215 my $alignString=''; # alignment as a string for dvi/pdf 216 my $alignList; # alignment as a list 217 218 if(defined($opts{'align'})) { 219 $alignString= $opts{'align'}; 220 $alignString =~ s/v/$opts{'midrule'}/g; 221 $alignString =~ tr/s/|/; # Treat "s" as "|" 222 $alignString =~ tr/n//; # Remove "n" altogether 223 @$alignList = split //, $alignString; 224 } else { 225 for($j=0; $j<$numCols; $j++) { 226 $alignList->[$j] = "c"; 227 $alignString .= "c"; 228 } 229 } 230 231 $out .= dm_begin_matrix($alignString, %opts); 232 # column labels for linear programming 233 $out .= dm_special_tops(%opts) if ($opts{'top_labels'}); 234 $out .= dm_mat_left($numRows, %opts); 235 # vertical lines put in with first row 236 $j = shift @myRows; 237 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows); 238 $out .= dm_mat_right($numRows, %opts); 239 for $j (@myRows) { 240 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>0); 241 } 242 $out .= dm_end_matrix(%opts); 243 $out; 244 } 245 246 sub dm_begin_matrix { 247 my ($aligns)=shift; #alignments of columns in table 248 my %opts = @_; 249 my $out = ""; 250 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 251 # This should be doable by regexp, but it wasn't working for me 252 my ($j, @tmp); 253 @tmp = split //, $aligns; 254 $aligns=''; 255 for $j (@tmp) { 256 # I still can't get an @ expression sent to TeX, so plain 257 # vertical line 258 $aligns .= ($j eq "d") ? '|' : $j; 259 } 260 $out .= $opts{'force_tex'} ? '' : '\('; 261 if($opts{'top_labels'}) { 262 $out .= '\begingroup\setbox3=\hbox{\ensuremath{'; 263 } 264 $out .= '\displaystyle\left'.$opts{'left'}."\\begin{array}{$aligns} \n"; 265 } elsif ($main::displayMode eq 'Latex2HTML') { 266 $out .= "\n\\begin{rawhtml} <TABLE BORDER=0>\n\\end{rawhtml}"; 267 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 268 or $main::displayMode eq 'HTML_dpng' 269 or $main::displayMode eq 'HTML_img') { 270 $out .= qq!<TABLE BORDER="0" Cellspacing="8">\n!; 271 } 272 else { 273 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; 274 } 275 $out; 276 } 277 278 sub dm_special_tops { 279 my %opts = @_; 280 my @top_labels = @{$opts{'top_labels'}}; 281 my $ncols = scalar(@top_labels); 282 my $out = ''; 283 my $j; 284 my ($brh, $erh) = ("",""); # Start and end raw html 285 if($main::displayMode eq 'Latex2HTML') { 286 $brh = "\\begin{rawhtml}"; 287 $erh = "\\end{rawhtml}"; 288 } 289 290 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 291 for $j (@top_labels) { 292 $out .= '\smash{\raisebox{2.9ex}{\ensuremath{'. 293 $j . '}}} &'; 294 } 295 chop($out); # remove last & 296 $out .= '\cr\noalign{\vskip -2.5ex}'."\n"; # want skip jump up 2.5ex 297 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 298 or $main::displayMode eq 'HTML_dpng' 299 or $main::displayMode eq 'HTML_img' 300 or $main::displayMode eq 'Latex2HTML') { 301 $out .= "$brh<tr><td>$erh"; # Skip a column for the left brace 302 for $j (@top_labels) { 303 $out .= "$brh<td>$erh". ' \('.$j.'\)'."$brh</td>$erh"; 304 } 305 } else { 306 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; 307 } 308 return $out; 309 } 310 311 sub dm_mat_left { 312 my $numrows = shift; 313 my %opts = @_; 314 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 315 return ""; # left delim is built into begin matrix 316 } 317 my $out=''; 318 my $j; 319 my ($brh, $erh) = ("",""); # Start and end raw html 320 if($main::displayMode eq 'Latex2HTML') { 321 $brh = "\\begin{rawhtml}"; 322 $erh = "\\end{rawhtml}"; 323 } 324 325 if($main::displayMode eq 'HTML_dpng' 326 or $main::displayMode eq 'HTML_img' 327 or $main::displayMode eq 'Latex2HTML') { 328 $out .= "$brh<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">$erh"; 329 $out .= dm_image_delimeter($numrows, $opts{'left'}); 330 # $out .= "$brh<td><table border=0 cellspacing=5>\n$erh"; 331 return $out; 332 } 333 # Mode is now tth 334 335 $out .= "<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">"; 336 $out .= dm_tth_delimeter($numrows, $opts{'left'}); 337 # $out .= "<td><table border=0 cellspacing=5>\n"; 338 return $out; 339 } 340 341 sub dm_mat_right { 342 my $numrows = shift; 343 my %opts = @_; 344 my $out=''; 345 my $j; 346 my ($brh, $erh) = ("",""); # Start and end raw html 347 if($main::displayMode eq 'Latex2HTML') { 348 $brh = "\\begin{rawhtml}"; 349 $erh = "\\end{rawhtml}"; 350 } 351 352 353 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 354 return ""; 355 } 356 357 if($main::displayMode eq 'HTML_dpng' 358 or $main::displayMode eq 'Latex2HTML' 359 or $main::displayMode eq 'HTML_dpng') { 360 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh"; 361 362 $out.= dm_image_delimeter($numrows, $opts{'right'}); 363 return $out; 364 } 365 366 # $out .= "</table>"; 367 $out .= '<td nowrap="nowrap" align="left" rowspan="'.$numrows.'2">'; 368 $out .= dm_tth_delimeter($numrows, $opts{'right'}); 369 $out .= '</td>'; 370 return $out; 371 } 372 373 sub dm_end_matrix { 374 my %opts = @_; 375 376 my $out = ""; 377 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 378 $out .= "\\end{array}\\right$opts{right}"; 379 $out .= $opts{'force_tex'} ? '' : "\\) "; 380 if($opts{'top_labels'}) { 381 $out .= '}} \dimen3=\ht3 \advance\dimen3 by 3ex \ht3=\dimen3'."\n". 382 '\box3\endgroup'; 383 } 384 } 385 elsif ($main::displayMode eq 'Latex2HTML') { 386 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}"; 387 } 388 elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 389 or $main::displayMode eq 'HTML_img' 390 or $main::displayMode eq 'HTML_dpng') { 391 $out .= "</TABLE>\n"; 392 } 393 else { 394 $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n"; 395 } 396 $out; 397 } 398 399 # Make an image of a big delimiter for a matrix 400 sub dm_image_delimeter { 401 my $numRows = shift; 402 my $char = shift; 403 my ($out, $j); 404 405 if($char eq ".") {return("");} 406 if($char eq "d") { # special treatment for dashed lines 407 $out='\(\vbox to '.($numRows*1.7).'\baselineskip '; 408 $out .='{\cleaders\hbox{\vbox{\hrule width0pt height3pt depth0pt'; 409 $out .='\hrule width0.3pt height6pt depth0pt'; 410 $out .='\hrule width0pt height3pt depth0pt}}\vfil}\)'; 411 return($out); 412 } 413 if($char eq "|") { 414 $out='\(\vbox to '.($numRows*1.4).'\baselineskip '; 415 $out .='{\cleaders\vrule width0.3pt'; 416 $out .='\vfil}\)'; 417 return($out); 418 } 419 if($char eq "{") {$char = '\lbrace';} 420 if($char eq "}") {$char = '\rbrace';} 421 $out .= '\(\setlength{\arraycolsep}{0in}\left.\begin{array}{c}'; 422 for($j=0;$j<=$numRows;$j++) { $out .= '\! \\\\'; } 423 $out .= '\end{array}\right'.$char.'\)'; 424 return($out); 425 } 426 427 # Basically uses a table of special characters and simple 428 # recipe to produce big delimeters a la tth mode 429 sub dm_tth_delimeter { 430 my $numRows = shift; 431 my $char = shift; 432 433 if($char eq ".") { return("");} 434 my ($top, $mid, $bot, $extra); 435 my ($j, $out); 436 437 if($char eq "(") { ($top, $mid, $bot, $extra) = ('æ','ç','è','ç');} 438 elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('ö','÷','ø','÷');} 439 elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('ê','ê','ê','ê');} 440 elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('é','ê','ë','ê');} 441 elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('ù','ú','û','ú');} 442 elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('ì','ï','î','í');} 443 elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('ü','ï','þ','ý');} 444 else { warn "Unknown delimiter in dm_tth_delimeter";} 445 446 # old version 447 # $out = '<td nowrap="nowrap" align="left"><font face="symbol">'; 448 $out = '<font face="symbol">'; 449 $out .= "$top<br />"; 450 for($j=1;$j<$numRows; $j++) { 451 $out .= "$mid<br />"; 452 } 453 $out .= "$extra<br />"; 454 for($j=1;$j<$numRows; $j++) { 455 $out .= "$mid<br />"; 456 } 457 $out .= "$bot</font></td>"; 458 return $out; 459 } 460 461 # Make a row for the matrix 462 sub dm_mat_row { 463 my $elements = shift; 464 my $tmp = shift; 465 my @align = @{$tmp} ; 466 my %opts = @_; 467 468 if($elements eq 'hline') { 469 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 470 return '\hline '; 471 } else { 472 # Making a hline in a table 473 return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>'; 474 } 475 } 476 477 my @elements = @{$elements}; 478 my $out = ""; 479 my ($brh, $erh) = ("",""); # Start and end raw html 480 my $element; 481 if($main::displayMode eq 'Latex2HTML') { 482 $brh = "\\begin{rawhtml}"; 483 $erh = "\\end{rawhtml}"; 484 } 485 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 486 while (@elements) { 487 $element= shift(@elements); 488 if(ref($element) eq 'Fraction') { 489 $element= $element->print_inline(); 490 } 491 $out .= "$element &"; 492 } 493 chop($out); # remove last & 494 $out .= "\\cr \n"; 495 # carriage returns must be added manually for tex 496 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 497 or $main::displayMode eq 'HTML_dpng' 498 or $main::displayMode eq 'HTML_img' 499 or $main::displayMode eq 'Latex2HTML') { 500 if(not $opts{'isfirst'}) { $out .= "$brh\n<TR>\n$erh";} 501 while (@elements) { 502 my $myalign; 503 $myalign = shift @align; 504 if($myalign eq "|" or $myalign eq "d") { 505 if($opts{'isfirst'} && $main::displayMode ne 'HTML_tth') { 506 $out .= $brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh; 507 $out .= dm_image_delimeter($opts{'isfirst'}-1, $myalign); 508 } elsif($main::displayMode eq 'HTML_tth') { 509 if($myalign eq "d") { # dashed line in tth mode 510 $out .= '<td> | </td>'; 511 } elsif($opts{'isfirst'}) { # solid line in tth mode 512 $out .= '<td rowspan="'.$opts{'isfirst'}.'"<table border="0"><tr>'; 513 $out .= dm_tth_delimeter($opts{'isfirst'}-1, "|"); 514 $out .= '</td></tr></table>'; 515 } 516 } 517 } else { 518 if($myalign eq "c") { $myalign = "center";} 519 if($myalign eq "l") { $myalign = "left";} 520 if($myalign eq "r") { $myalign = "right";} 521 $element= shift(@elements); 522 if (ref($element) eq 'Fraction') { 523 $element= $element->print_inline(); 524 } 525 $out .= "$brh<TD nowrap=\"nowrap\" align=\"$myalign\">$erh" . 526 $element . "$brh</TD>$erh"; 527 } 528 } 529 if(not $opts{'isfirst'}) {$out .="$brh</TR>$erh\n";} 530 } 531 else { 532 $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n"; 533 } 534 $out; 535 } 536 537 =head4 mbox 538 539 Usage \{ mbox(thing1, thing2, thing3) \} 540 \{ mbox([thing1, thing2, thing3], valign=>'top') \} 541 542 mbox takes a list of constructs, such as strings, or outputs of 543 display_matrix, and puts them together on a line. Without mbox, the 544 output of display_matrix would always start a new line. 545 546 The inputs can be just listed, or given as a reference to an array. 547 With the latter, optional arguments can be given. 548 549 Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX 550 output; and valign which sets vertical alignment on web page output. 551 552 =cut 553 554 sub mbox { 555 my $inList = shift; 556 my %opts; 557 if(ref($inList) eq 'ARRAY') { 558 %opts = @_; 559 } else { 560 %opts = (); 561 $inList = [$inList, @_]; 562 } 563 564 set_default_options(\%opts, 565 '_filter_name' => 'mbox', 566 'valign' => 'middle', 567 'allowbreaks' => 'no', 568 'allow_unknown_options'=> 0); 569 if(! $opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';} 570 my $out = ""; 571 my $j; 572 my ($brh, $erh) = ("",""); # Start and end raw html if needed 573 if($main::displayMode eq 'Latex2HTML') { 574 $brh = "\\begin{rawhtml}"; 575 $erh = "\\end{rawhtml}"; 576 } 577 my @hlist = @{$inList}; 578 if($main::displayMode eq 'TeX') { 579 if($opts{allowbreaks} ne 'no') {$out .= '\mbox{';} 580 for $j (@hlist) { $out .= $j;} 581 if($opts{allowbreaks} ne 'no') {$out .= '}';} 582 } else { 583 $out .= qq!$brh<table><tr valign="$opts{'valign'}">$erh!; 584 for $j (@hlist) { 585 $out .= qq!$brh<td align="center" nowrap="nowrap">$erh$j$brh</td>$erh!; 586 } 587 $out .= "$brh</table>$erh"; 588 } 589 return $out; 590 } 591 592 593 =head4 ra_flatten_matrix 594 595 Usage: ra_flatten_matrix($A) 596 597 where $A is a matrix object 598 The output is a reference to an array. The matrix is placed in the array by iterating 599 over columns on the inside 600 loop, then over the rows. (e.g right to left and then down, as one reads text) 601 602 603 =cut 604 605 606 sub ra_flatten_matrix{ 607 my $matrix = shift; 608 warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/; 609 my @array = (); 610 my ($rows, $cols ) = $matrix->dim(); 611 foreach my $i (1..$rows) { 612 foreach my $j (1..$cols) { 613 push(@array, $matrix->element($i,$j) ); 614 } 615 } 616 \@array; 617 } 618 619 # 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 621 # of matrices (e.g. mod 2) for indice matrices. 622 sub apl_matrix_mult{ 623 my $ra_a= shift; 624 my $ra_b= shift; 625 my %options = @_; 626 my $rf_op_times= sub {$_[0] *$_[1]}; 627 my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; }; 628 $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE'; 629 $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE'; 630 my $rows = @$ra_a; 631 my $cols = @{$ra_b->[0]}; 632 my $k_size = @$ra_b; 633 my $out ; 634 my ($i, $j, $k); 635 for($i=0;$i<$rows;$i++) { 636 for($j=0;$j<$cols;$j++) { 637 my @r = (); 638 for($k=0;$k<$k_size;$k++) { 639 $r[$k] = &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]); 640 } 641 $out->[$i]->[$j] = &$rf_op_plus( @r ); 642 } 643 } 644 $out; 645 } 646 647 sub matrix_mult { 648 apl_matrix_mult($_[0], $_[1]); 649 } 650 651 sub make_matrix{ 652 my $function = shift; 653 my $rows = shift; 654 my $cols = shift; 655 my ($i, $j, $k); 656 my $ra_out; 657 for($i=0;$i<$rows;$i++) { 658 for($j=0;$j<$cols;$j++) { 659 $ra_out->[$i]->[$j] = &$function($i,$j); 660 } 661 } 662 $ra_out; 663 } 664 665 666 =head5 answer_matrix 667 668 Usage \[ \{ answer_matrix(rows,columns,width_of_ans_rule, @options) \} \] 669 670 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 672 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 674 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.) 676 677 The options are passed on to display_matrix. 678 679 680 =cut 681 682 683 sub answer_matrix{ 684 my $m = shift; 685 my $n = shift; 686 my $width = shift; 687 my @options = @_; 688 my @array=(); 689 for( my $i = 0; $i < $m; $i+=1) 690 { 691 my @row_array = (); 692 693 for( my $i = 0; $i < $n; $i+=1) 694 { 695 push @row_array, ans_rule($width); 696 } 697 my $r_row_array = \@row_array; 698 push @array, $r_row_array; 699 } 700 display_matrix( \@array, @options ); 701 702 } 703 704 # sub format_answer{ 705 # my $ra_eigenvalues = shift; 706 # my $ra_eigenvectors = shift; 707 # my $functionName = shift; 708 # my @eigenvalues=@$ra_eigenvalues; 709 # my $size= @eigenvalues; 710 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 711 # my $out = qq! 712 # $functionName(t) =! . 713 # displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen, 714 # 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''}, 715 # 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } 716 # ) ) ; 717 # $out; 718 # } 719 # sub format_vector_answer{ 720 # my $ra_eigenvalues = shift; 721 # my $ra_eigenvectors = shift; 722 # my $functionName = shift; 723 # my @eigenvalues=@$ra_eigenvalues; 724 # my $size= @eigenvalues; 725 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 726 # my $out = qq! 727 # $functionName(t) =! . 728 # displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ; 729 # $out; 730 # } 731 # sub format_question{ 732 # my $ra_matrix = shift; 733 # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! 734 # 735 # } 736 737 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |