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