[system] / trunk / pg / macros / PGmatrixmacros.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /trunk/pg/macros/PGmatrixmacros.pl

Wed Jul 9 20:29:04 2003 UTC (16 years, 6 months ago) by lr003k
File size: 30258 byte(s)
Fixed a rounding problem.


    1 ###########
2 #use Carp;
3
5
6         Matrix macros for the PG language
7
9
10
11
13
14 Almost all of the macros in the file are very rough at best.  The most useful is display_matrix.
15 Many of the other macros work with vectors and matrices stored as anonymous arrays.
16
17 Frequently it may be
18 more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there.
19
20
21 =cut
22
23 BEGIN {
24         be_strict();
25 }
26
27 sub _PGmatrixmacros_init {
28 }
29
30 # this subroutine zero_check is not very well designed below -- if it is used much it should receive
31 # more work -- particularly for checking relative tolerance.  More work needs to be done if this is
32 # actually used.
33
34 sub zero_check{
35     my $array = shift; 36 my %options = @_; 37 my$num = @$array; 38 my$i;
39         my $max = 0; my$mm;
40         for ($i=0;$i< $num;$i++) {
41                 $mm =$array->[$i] ; 42$max = abs($mm) if abs($mm) > $max; 43 } 44 my$tol = $options{tol}; 45$tol = 0.01*$options{reltol}*$options{avg} if defined($options{reltol}) and defined$options{avg};
46     $tol = .000001 unless defined($tol);
47         ($max <$tol) ? 1: 0;       # 1 if the array is close to zero;
48 }
49 sub vec_dot{
50         my $vec1 = shift; 51 my$vec2 = shift;
52         warn "vectors must have the same length" unless @$vec1 == @$vec2;  # the vectors must have the same length.
53         my @vec1=@$vec1; 54 my @vec2=@$vec2;
55         my $sum = 0; 56 57 while(@vec1) { 58$sum += shift(@vec1)*shift(@vec2);
59         }
60         $sum; 61 } 62 sub proj_vec { 63 my$vec = shift;
64         warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and${$vec->dim()}[1] == 1; 65 my$matrix = shift;    # the matrix represents a set of vectors spanning the linear space
66                                # onto which we want to project the vector.
67         warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and${$matrix->dim()}[1] ==${$vec->dim()}[0]; 68$matrix * transpose($matrix) *$vec;
69 }
70
71 sub vec_cmp{    #check to see that the submitted vector is a non-zero multiple of the correct vector
72     my $correct_vector = shift; 73 my %options = @_; 74 my$ans_eval = sub {
75                 my $in = shift @_; 76 77 my$ans_hash = new AnswerHash;
78                 my @in = split("\0",$in); 79 my @correct_vector=@$correct_vector;
80                 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 81$ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )";
82
83                 return($ans_hash) unless @$correct_vector == @in;  # make sure the vectors are the same dimension
84
85                 my $correct_length = vec_dot($correct_vector,$correct_vector); 86 my$in_length = vec_dot(\@in,\@in);
87                 return($ans_hash) if$in_length == 0;
88
89                 if (defined($correct_length) and$correct_length != 0) {
90                         my $constant = vec_dot($correct_vector,\@in)/$correct_length; 91 my @difference = (); 92 for(my$i=0; $i < @correct_vector;$i++ ) {
93                                 $difference[$i]=$constant*$correct_vector[$i] -$in[$i]; 94 } 95$ans_hash->{score} = zero_check(\@difference);
96
97                 } else {
98                         $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; 99 } 100$ans_hash;
101
102     };
103
104     $ans_eval; 105 } 106 107 ############ 108 109 =head4 display_matrix 110 111 Usage \{ display_matrix( [ [1, '$$\sin x$$'], [ans_rule(5), 6] ]) \} 112 \{ display_matrix($A, align=>'crvl') \}
113                   $\{ display_matrix_mm(A) \}$
114                         $\{ display_matrix_mm([ [1, 3], [4, 6] ]) \}$
115
116     display_matrix produces a matrix for display purposes.  It checks whether
117           it is producing LaTeX output, or if it is displaying on a web page in one
118           of the various modes.  The input can either be of type Matrix, or a
119           reference to an array.
120
121           Entries can be numbers, Fraction objects, bits of math mode, or answer
122     boxes.  An entire row can be replaced by the string 'hline' to produce
123     a horizontal line in the matrix.
124
125           display_matrix_mm functions similarly, except that it should be inside
126           math mode.  display_matrix_mm cannot contain answer boxes in its entries.
127           Entries to display_matrix_mm should assume that they are already in
128           math mode.
129
130           Both functions take an optional alignment string, similar to ones in
131           LaTeX tabulars and arrays.  Here c for centered columns, l for left
132           flushed columns, and r for right flushed columns.
133
134           The alignment string can also specify vertical rules to be placed in the
135           matrix.  Here s or | denote a solid line, d is a dashed line, and v
136           requests the default vertical line.  This can be set on a system-wide
137           or course-wide basis via the variable $defaultDisplayMatrixStyle, and 138 it can default to solid, dashed, or no vertical line (n for none). 139 140 The matrix has left and right delimiters also specified by 141$defaultDisplayMatrixStyle.  They can be parentheses, square brackets,
142         braces, vertical bars, or none.  The default can be overridden in
143           an individual problem with optional arguments such as left=>"|", or
144           right=>"]".
145
146     You can specify an optional argument of 'top_labels'=> ['a', 'b', 'c'].
147     These are placed above the columns of the matrix (as is typical for
148     linear programming tableau, for example).  The entries will be typeset
149     in math mode.
150
151     Top labels require a bit of care.  For image modes, they look better
152     with display_matrix_mm where it is all one big image, but they work with
153     display_matrix.  With tth, you pretty much have to use display_matrix
154     since tth can't handle the TeX tricks used to get the column headers
155     up there if it gets the whole matrix at once.
156
157
158 =cut
159
160
161 sub display_matrix_mm{    # will display a matrix in tex format.
162                        # the matrix can be either of type array or type 'Matrix'
163         return display_matrix(@_, 'force_tex'=>1);
164 }
165
166 sub display_matrix_math_mode {
167         return display_matrix_mm(@_);
168 }
169
170 sub display_matrix {
171         my $ra_matrix = shift; 172 my %opts = @_; 173 my$styleParams = defined($main::defaultDisplayMatrixStyle) ? 174$main::defaultDisplayMatrixStyle : "(s)";
175
176         set_default_options(\%opts,
177                                                                                         '_filter_name' => 'display_matrix',
178                                                                                         'force_tex' => 0,
179                                                                                         'left' => substr($styleParams,0,1), 180 'right' => substr($styleParams,2,1),
181                                                                                         'midrule' => substr($styleParams,1,1), 182 'top_labels' => 0, 183 'box'=>[-1,-1], # pair location of boxed element 184 'allow_unknown_options'=> 1, 185 'num_format' => "%.0f", 186 ); 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 as [ [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
214         my $out; 215 my$j;
216         my alignString=''; # alignment as a string for dvi/pdf 217 myalignList;      # alignment as a list
218
219         if(defined(opts{'align'})) { 220alignString= opts{'align'}; 221alignString =~ s/v/$opts{'midrule'}/g; 222$alignString =~ tr/s/|/; # Treat "s" as "|"
223                 alignString =~ tr/n//; # Remove "n" altogether 224 @alignList = split //, alignString; 225 } else { 226 for(j=0; $j<$numCols; $j++) { 227$alignList->[$j] = "c"; 228$alignString .= "c";
229                 }
230         }
231         # Before we start, we cannot let top_labels proceed if we
232         # are in tth mode and force_tex is true since tth can't handle
233         # the resulting code
234         if($opts{'force_tex'} and$main::displayMode eq 'HTML_tth') {
235                 $opts{'top_labels'} = 0; 236 } 237 238$out .= dm_begin_matrix(alignString, %opts); 239 # column labels for linear programming 240out .= dm_special_tops(%opts, 'alignList'=>alignList) if (opts{'top_labels'});
241         $out .= dm_mat_left($numRows, %opts);
242   my $cnt = 1; # we count rows in in case an element is boxed 243 # vertical lines put in with first row 244$j = shift @myRows;
245         $out .= dm_mat_row($j, alignList, %opts, 'isfirst'=>numRows,
246     'cnt' => $cnt); 247$cnt++ unless ($j eq 'hline'); 248$out .= dm_mat_right($numRows, %opts); 249 for$j (@myRows) {
250                 $out .= dm_mat_row($j, alignList, %opts, 'isfirst'=>0, 251 'cnt' =>cnt);
252     $cnt++ unless ($j eq 'hline');
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 myout =        "";
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 forj (@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 my$colcount=0;
500         if($main::displayMode eq 'Latex2HTML') { 501$brh = "\\begin{rawhtml}";
502                 $erh = "\\end{rawhtml}"; 503 } 504 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { 505 while (@elements) { 506$colcount++;
507       $out .= '\fbox{' if ($colcount == $opts{'box'}->[1] and$opts{'cnt'}  == $opts{'box'}->[0]); 508$element= shift(@elements);
509                         if(ref($element) eq 'Fraction') { 510$element=  $element->print_inline(); 511 } 512$out .= "$element"; 513$out .= '}' if ($colcount ==$opts{'box'}->[1] and $opts{'cnt'} ==$opts{'box'}->[0]);
514                         $out .= " &"; 515 } 516 chop($out); # remove last &
517                 $out .= "\\cr \n"; 518 # carriage returns must be added manually for tex 519 } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth' 520 or$main::displayMode eq 'HTML_dpng'
521                                  or $main::displayMode eq 'HTML_img' 522 or$main::displayMode eq 'Latex2HTML') {
523                         if(not $opts{'isfirst'}) {$out .=  "$brh\n<TR>\n$erh";}
524                 while (@elements) {
525                         my myalign; 526myalign = shift @align;
527                         if(myalign eq "|" ormyalign eq "d") {
528                                 if($opts{'isfirst'} &&$main::displayMode ne 'HTML_tth') {
529                                         $out .=$brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh;
530                                         $out .= dm_image_delimeter($opts{'isfirst'}-1, myalign); 531 } elsif(main::displayMode eq 'HTML_tth') {
532                                         if(myalign eq "d") { # dashed line in tth mode 533out .= '<td> | </td>';
534                                         } elsif($opts{'isfirst'}) { # solid line in tth mode 535$out .= '<td rowspan="'.$opts{'isfirst'}.'"<table border="0"><tr>'; 536$out .= dm_tth_delimeter($opts{'isfirst'}-1, "|"); 537$out .= '</td></tr></table>';
538                                         }
539                                 }
540                         } else {
541                                 if(myalign eq "c") {myalign = "center";}
542                                 if(myalign eq "l") {myalign = "left";}
543                                 if(myalign eq "r") {myalign = "right";}
544         $colcount++; 545$out .= '\fbox{' if ($colcount ==$opts{'box'}->[1] and $opts{'cnt'} ==$opts{'box'}->[0]);
546                                 $element= shift(@elements); 547 if (ref($element) eq 'Fraction') {
548                                         $element=$element->print_inline();
549                                 }elsif( $element =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ and $element != sprintf($opts{'num_format'},$element) and$element - sprintf($opts{'num_format'},$element) < $main::functZeroLevelTolDefault){ 550$element = sprintf($opts{'num_format'},$element);
551           $element = 0 if abs($element) < $main::functZeroLevelTolDefault; 552 } 553$out .= "brh<TD nowrap=\"nowrap\" align=\"myalign\">$erh"; 554$out .= '<table border="1"><tr><td>' if ($colcount ==$opts{'box'}->[1] and $opts{'cnt'} ==$opts{'box'}->[0]);
555                                 $out .=$element;
556                                 $out .= '</td></tr></table>' if ($colcount == $opts{'box'}->[1] and$opts{'cnt'} == $opts{'box'}->[0]); 557$out .= "$brh</TD>$erh";
558                         }
559                 }
560                         if(not $opts{'isfirst'}) {$out .="$brh</TR>$erh\n";}
561         }
562         else {
563                 $out = "Error: dm_mat_row: Unknown displayMode:$main::displayMode.\n";
564                 }
565         out; 566 } 567 568 =head4 mbox 569 570 Usage \{ mbox(thing1, thing2, thing3) \} 571 \{ mbox([thing1, thing2, thing3], valign=>'top') \} 572 573 mbox takes a list of constructs, such as strings, or outputs of 574 display_matrix, and puts them together on a line. Without mbox, the 575 output of display_matrix would always start a new line. 576 577 The inputs can be just listed, or given as a reference to an array. 578 With the latter, optional arguments can be given. 579 580 Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX 581 output; and valign which sets vertical alignment on web page output. 582 583 =cut 584 585 sub mbox { 586 myinList = shift;
587         my %opts;
588         if(ref($inList) eq 'ARRAY') { 589 %opts = @_; 590 } else { 591 %opts = (); 592$inList = [inList, @_]; 593 } 594 595 set_default_options(\%opts, 596 '_filter_name' => 'mbox', 597 'valign' => 'middle', 598 'allowbreaks' => 'no', 599 'allow_unknown_options'=> 0); 600 if(!opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';} 601 my$out = "";
602         my $j; 603 my ($brh, $erh) = ("",""); # Start and end raw html if needed 604 if($main::displayMode eq 'Latex2HTML') {
605                 $brh = "\\begin{rawhtml}"; 606$erh = "\\end{rawhtml}";
607         }
608         my @hlist = @{$inList}; 609 if($main::displayMode eq 'TeX') {
610                 if($opts{allowbreaks} ne 'no') {$out .= '\mbox{';}
611                 for $j (@hlist) {$out .= $j;} 612 if($opts{allowbreaks} ne 'no') {$out .= '}';} 613 } else { 614$out .= qq!brh<table><tr valign="opts{'valign'}">$erh!; 615 for$j (@hlist) {
616                         $out .= qq!$brh<td align="center" nowrap="nowrap">$erh$j$brh</td>$erh!;
617                 }
618                 $out .= "$brh</table>$erh"; 619 } 620 return$out;
621 }
622
623
625
626                 Usage:   ra_flatten_matrix($A) 627 628 where$A is a matrix object
629                         The output is a reference to an array.  The matrix is placed in the array by iterating
630                         over  columns on the inside
631                         loop, then over the rows. (e.g right to left and then down, as one reads text)
632
633
634 =cut
635
636
637 sub ra_flatten_matrix{
638         my $matrix = shift; 639 warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/;
640         my @array = ();
641         my ($rows,$cols ) = $matrix->dim(); 642 foreach my$i (1..$rows) { 643 foreach my$j (1..$cols) { 644 push(@array,$matrix->element($i,$j)  );
645                 }
646         }
647         \@array;
648 }
649
650 # This subroutine is probably obsolete and not generally useful.  It was patterned after the APL
651 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of
652 # of matrices (e.g. mod 2) for indice matrices.
653 sub apl_matrix_mult{
654         my $ra_a= shift; 655 my$ra_b= shift;
656         my %options = @_;
657         my $rf_op_times= sub {$_[0] *$_[1]}; 658 my$rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){$sum = $sum + shift(@in) }$sum; };
659         $rf_op_times =$options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE';
660         $rf_op_plus =$options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE';
661         my $rows = @$ra_a;
662         my $cols = @{$ra_b->[0]};
663         my $k_size = @$ra_b;
664         my $out ; 665 my ($i, $j,$k);
666         for($i=0;$i<$rows;$i++) {
667                 for($j=0;$j<$cols;$j++) {
668                     my @r = ();
669                     for($k=0;$k<$k_size;$k++) {
670                             $r[$k] =  &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]); 671 } 672$out->[$i]->[$j] = &$rf_op_plus( @r ); 673 } 674 } 675$out;
676 }
677
678 sub matrix_mult {
679         apl_matrix_mult($_[0],$_[1]);
680 }
681
682 sub make_matrix{
683         my $function = shift; 684 my$rows = shift;
685         my $cols = shift; 686 my ($i, $j,$k);
687         my $ra_out; 688 for($i=0;$i<$rows;$i++) { 689 for($j=0;$j<$cols;$j++) { 690$ra_out->[$i]->[$j] = &$function($i,$j); 691 } 692 } 693$ra_out;
694 }
695
696
698 #       my $ra_eigenvalues = shift; 699 # my$ra_eigenvectors = shift;
700 #       my $functionName = shift; 701 # my @eigenvalues=@$ra_eigenvalues;
702 #       my $size= @eigenvalues; 703 # my$ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
704 #       my $out = qq! 705 #$functionName(t) =! .
706 #                                                   displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen,
707 #                                     'times'=>sub{($_[0] and$_[1]) ? "$_[0]$_[1]"  : ''},
708 #                                     'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } 709 # ) ) ; 710 #$out;
711 # }
713 #       my $ra_eigenvalues = shift; 714 # my$ra_eigenvectors = shift;
715 #       my $functionName = shift; 716 # my @eigenvalues=@$ra_eigenvalues;
717 #       my $size= @eigenvalues; 718 # my$ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
719 #       my $out = qq! 720 #$functionName(t) =! .
721 #                                                   displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ;
722 #        $out; 723 # } 724 # sub format_question{ 725 # my$ra_matrix = shift;
726 #       my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)!
727 #
728 # }
729
730 1;