[system] / trunk / pg / macros / PGmatrixmacros.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/PGmatrixmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2267 - (view) (download) (as text)

1 : sh002i 1050 ###########
2 :     #use Carp;
3 :    
4 :     =head1 NAME
5 :    
6 : lr003k 1127 Matrix macros for the PG language
7 : sh002i 1050
8 :     =head1 SYNPOSIS
9 :    
10 :    
11 :    
12 :     =head1 DESCRIPTION
13 :    
14 :     Almost all of the macros in the file are very rough at best. The most useful is display_matrix.
15 : jj 1097 Many of the other macros work with vectors and matrices stored as anonymous arrays.
16 : sh002i 1050
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 : lr003k 1127 be_strict();
25 : sh002i 1050 }
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 : jj 1097 # more work -- particularly for checking relative tolerance. More work needs to be done if this is
32 : sh002i 1050 # actually used.
33 :    
34 :     sub zero_check{
35 :     my $array = shift;
36 :     my %options = @_;
37 : lr003k 1127 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 : sh002i 1050 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 : lr003k 1127 ($max <$tol) ? 1: 0; # 1 if the array is close to zero;
48 : sh002i 1050 }
49 :     sub vec_dot{
50 : lr003k 1127 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 : sh002i 1050
57 : lr003k 1127 while(@vec1) {
58 :     $sum += shift(@vec1)*shift(@vec2);
59 :     }
60 :     $sum;
61 : sh002i 1050 }
62 :     sub proj_vec {
63 : lr003k 1127 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 : sh002i 1050 }
70 : lr003k 1127
71 : sh002i 1050 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 : lr003k 1127 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 : sh002i 1050
83 : lr003k 1127 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 : sh002i 1050
89 : lr003k 1127 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 : sh002i 1050 };
103 : jj 1097
104 : sh002i 1050 $ans_eval;
105 :     }
106 :    
107 :     ############
108 :    
109 :     =head4 display_matrix
110 :    
111 : lr003k 1127 Usage \{ display_matrix( [ [1, '\(\sin x\)'], [ans_rule(5), 6] ]) \}
112 : gage 1066 \{ display_matrix($A, align=>'crvl') \}
113 : lr003k 1127 \[ \{ display_matrix_mm($A) \} \]
114 :     \[ \{ display_matrix_mm([ [1, 3], [4, 6] ]) \} \]
115 : sh002i 1050
116 : gage 1066 display_matrix produces a matrix for display purposes. It checks whether
117 : lr003k 1127 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 : sh002i 1050
121 : lr003k 1127 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 : gage 1066
125 : lr003k 1127 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 : gage 1066
130 : lr003k 1127 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 : gage 1066
134 : lr003k 1127 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 : gage 1066
140 : lr003k 1127 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 : gage 1066
146 : lr003k 1127 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 : jj 1318 linear programming tableau, for example). The entries will be typeset
149 : lr003k 1127 in math mode.
150 : gage 1066
151 : lr003k 1127 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 : sh002i 1050 =cut
159 :    
160 :    
161 : jj 1097 sub display_matrix_mm{ # will display a matrix in tex format.
162 : sh002i 1050 # the matrix can be either of type array or type 'Matrix'
163 : lr003k 1127 return display_matrix(@_, 'force_tex'=>1);
164 : gage 1066 }
165 :    
166 :     sub display_matrix_math_mode {
167 : lr003k 1127 return display_matrix_mm(@_);
168 : gage 1066 }
169 :    
170 :     sub display_matrix {
171 : lr003k 1127 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 : jj 1319 'box'=>[-1,-1], # pair location of boxed element
184 : lr003k 1332 'allow_unknown_options'=> 1,
185 :     'num_format' => "%.0f",
186 :     );
187 : lr003k 1127
188 :     my ($numRows, $numCols, @myRows);
189 : gage 1066
190 : lr003k 1127 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 :     my $alignList; # alignment as a list
218 : gage 1066
219 : lr003k 1127 if(defined($opts{'align'})) {
220 :     $alignString= $opts{'align'};
221 :     $alignString =~ 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
240 : jj 1318 $out .= dm_special_tops(%opts, 'alignList'=>$alignList) if ($opts{'top_labels'});
241 : lr003k 1127 $out .= dm_mat_left($numRows, %opts);
242 : jj 1319 my $cnt = 1; # we count rows in in case an element is boxed
243 : lr003k 1127 # vertical lines put in with first row
244 :     $j = shift @myRows;
245 : jj 1319 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows,
246 :     'cnt' => $cnt);
247 :     $cnt++ unless ($j eq 'hline');
248 : lr003k 1127 $out .= dm_mat_right($numRows, %opts);
249 :     for $j (@myRows) {
250 : jj 1319 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>0,
251 :     'cnt' => $cnt);
252 :     $cnt++ unless ($j eq 'hline');
253 : lr003k 1127 }
254 :     $out .= dm_end_matrix(%opts);
255 :     $out;
256 : sh002i 1050 }
257 :    
258 : gage 1066 sub dm_begin_matrix {
259 : lr003k 1127 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 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
281 :     or $main::displayMode eq 'HTML_asciimath'
282 : lr003k 1127 or $main::displayMode eq 'HTML_dpng'
283 :     or $main::displayMode eq 'HTML_img') {
284 :     $out .= qq!<TABLE BORDER="0" Cellspacing="8">\n!;
285 :     }
286 :     else {
287 :     $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
288 :     }
289 :     $out;
290 : gage 1066 }
291 : sh002i 1050
292 : lr003k 1127 sub dm_special_tops {
293 :     my %opts = @_;
294 :     my @top_labels = @{$opts{'top_labels'}};
295 :     my $out = '';
296 : jj 1318 my @alignList = @{$opts{'alignList'}};
297 :     my ($j, $k);
298 : lr003k 1127 my ($brh, $erh) = ("",""); # Start and end raw html
299 :     if($main::displayMode eq 'Latex2HTML') {
300 :     $brh = "\\begin{rawhtml}";
301 :     $erh = "\\end{rawhtml}";
302 :     }
303 :    
304 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
305 :     for $j (@top_labels) {
306 :     $out .= '\smash{\raisebox{2.9ex}{\ensuremath{'.
307 :     $j . '}}} &';
308 :     }
309 :     chop($out); # remove last &
310 :     $out .= '\cr\noalign{\vskip -2.5ex}'."\n"; # want skip jump up 2.5ex
311 :     } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
312 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
313 :     or $main::displayMode eq 'HTML_asciimath'
314 : lr003k 1127 or $main::displayMode eq 'HTML_dpng'
315 :     or $main::displayMode eq 'HTML_img'
316 :     or $main::displayMode eq 'Latex2HTML') {
317 :     $out .= "$brh<tr><td>$erh"; # Skip a column for the left brace
318 :     for $j (@top_labels) {
319 : jj 1318 $k = shift @alignList;
320 :     while(defined($k) and ($k !~ /[lrc]/)) {
321 :     $out .= "$brh<td></td>$erh";
322 :     $k = shift @alignList;
323 :     }
324 :     $out .= "$brh<td align=\"center\">$erh". ' \('.$j.'\)'."$brh</td>$erh";
325 : lr003k 1127 }
326 : jj 1318 $out .= "<td></td>";
327 : lr003k 1127 } else {
328 :     $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
329 :     }
330 :     return $out;
331 :     }
332 : gage 1066
333 :     sub dm_mat_left {
334 : lr003k 1127 my $numrows = shift;
335 :     my %opts = @_;
336 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
337 :     return ""; # left delim is built into begin matrix
338 :     }
339 :     my $out='';
340 :     my $j;
341 :     my ($brh, $erh) = ("",""); # Start and end raw html
342 :     if($main::displayMode eq 'Latex2HTML') {
343 :     $brh = "\\begin{rawhtml}";
344 :     $erh = "\\end{rawhtml}";
345 :     }
346 : gage 1066
347 : lr003k 1127 if($main::displayMode eq 'HTML_dpng'
348 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
349 :     or $main::displayMode eq 'HTML_asciimath'
350 : lr003k 1127 or $main::displayMode eq 'HTML_img'
351 :     or $main::displayMode eq 'Latex2HTML') {
352 :     $out .= "$brh<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">$erh";
353 :     $out .= dm_image_delimeter($numrows, $opts{'left'});
354 :     # $out .= "$brh<td><table border=0 cellspacing=5>\n$erh";
355 :     return $out;
356 :     }
357 :     # Mode is now tth
358 : gage 1066
359 : lr003k 1127 $out .= "<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">";
360 :     $out .= dm_tth_delimeter($numrows, $opts{'left'});
361 :     # $out .= "<td><table border=0 cellspacing=5>\n";
362 :     return $out;
363 : gage 1066 }
364 :    
365 :     sub dm_mat_right {
366 : lr003k 1127 my $numrows = shift;
367 :     my %opts = @_;
368 :     my $out='';
369 :     my $j;
370 :     my ($brh, $erh) = ("",""); # Start and end raw html
371 :     if($main::displayMode eq 'Latex2HTML') {
372 :     $brh = "\\begin{rawhtml}";
373 :     $erh = "\\end{rawhtml}";
374 :     }
375 : gage 1066
376 : lr003k 1127
377 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
378 :     return "";
379 :     }
380 : gage 1066
381 : lr003k 1127 if($main::displayMode eq 'HTML_dpng'
382 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
383 :     or $main::displayMode eq 'HTML_asciimath'
384 : lr003k 1127 or $main::displayMode eq 'Latex2HTML'
385 : dpvc 2267 or $main::displayMode eq 'HTML_img') {
386 : lr003k 1127 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh";
387 :    
388 :     $out.= dm_image_delimeter($numrows, $opts{'right'});
389 :     return $out;
390 :     }
391 : lr003k 1121
392 : lr003k 1127 # $out .= "</table>";
393 :     $out .= '<td nowrap="nowrap" align="left" rowspan="'.$numrows.'2">';
394 :     $out .= dm_tth_delimeter($numrows, $opts{'right'});
395 :     $out .= '</td>';
396 :     return $out;
397 : gage 1066 }
398 :    
399 :     sub dm_end_matrix {
400 : lr003k 1127 my %opts = @_;
401 :    
402 :     my $out = "";
403 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
404 :     $out .= "\\end{array}\\right$opts{right}";
405 :     if($opts{'top_labels'}) {
406 :     $out .= '}} \dimen3=\ht3 \advance\dimen3 by 3ex \ht3=\dimen3'."\n".
407 :     '\box3\endgroup';
408 :     }
409 : jj 1318 $out .= $opts{'force_tex'} ? '' : "\\) ";
410 : lr003k 1127 }
411 :     elsif ($main::displayMode eq 'Latex2HTML') {
412 :     $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
413 :     }
414 :     elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
415 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
416 :     or $main::displayMode eq 'HTML_asciimath'
417 : lr003k 1127 or $main::displayMode eq 'HTML_img'
418 :     or $main::displayMode eq 'HTML_dpng') {
419 :     $out .= "</TABLE>\n";
420 :     }
421 :     else {
422 :     $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n";
423 :     }
424 :     $out;
425 : gage 1066 }
426 :    
427 :     # Make an image of a big delimiter for a matrix
428 :     sub dm_image_delimeter {
429 : lr003k 1127 my $numRows = shift;
430 :     my $char = shift;
431 :     my ($out, $j);
432 : gage 1066
433 : lr003k 1127 if($char eq ".") {return("");}
434 :     if($char eq "d") { # special treatment for dashed lines
435 :     $out='\(\vbox to '.($numRows*1.7).'\baselineskip ';
436 :     $out .='{\cleaders\hbox{\vbox{\hrule width0pt height3pt depth0pt';
437 :     $out .='\hrule width0.3pt height6pt depth0pt';
438 :     $out .='\hrule width0pt height3pt depth0pt}}\vfil}\)';
439 :     return($out);
440 :     }
441 :     if($char eq "|") {
442 :     $out='\(\vbox to '.($numRows*1.4).'\baselineskip ';
443 :     $out .='{\cleaders\vrule width0.3pt';
444 :     $out .='\vfil}\)';
445 :     return($out);
446 :     }
447 :     if($char eq "{") {$char = '\lbrace';}
448 :     if($char eq "}") {$char = '\rbrace';}
449 :     $out .= '\(\setlength{\arraycolsep}{0in}\left.\begin{array}{c}';
450 :     for($j=0;$j<=$numRows;$j++) { $out .= '\! \\\\'; }
451 :     $out .= '\end{array}\right'.$char.'\)';
452 :     return($out);
453 : gage 1066 }
454 :    
455 :     # Basically uses a table of special characters and simple
456 :     # recipe to produce big delimeters a la tth mode
457 :     sub dm_tth_delimeter {
458 : lr003k 1127 my $numRows = shift;
459 :     my $char = shift;
460 : gage 1066
461 : lr003k 1127 if($char eq ".") { return("");}
462 :     my ($top, $mid, $bot, $extra);
463 :     my ($j, $out);
464 : gage 1066
465 : lr003k 1127 if($char eq "(") { ($top, $mid, $bot, $extra) = ('','','','');}
466 :     elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('','','','');}
467 :     elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('','','','');}
468 :     elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('','','','');}
469 :     elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('','','','');}
470 :     elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('','','','');}
471 :     elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('','','','');}
472 :     else { warn "Unknown delimiter in dm_tth_delimeter";}
473 : gage 1066
474 : lr003k 1127 # old version
475 :     # $out = '<td nowrap="nowrap" align="left"><font face="symbol">';
476 :     $out = '<font face="symbol">';
477 :     $out .= "$top<br />";
478 :     for($j=1;$j<$numRows; $j++) {
479 :     $out .= "$mid<br />";
480 :     }
481 :     $out .= "$extra<br />";
482 :     for($j=1;$j<$numRows; $j++) {
483 :     $out .= "$mid<br />";
484 :     }
485 :     $out .= "$bot</font></td>";
486 :     return $out;
487 : gage 1066 }
488 :    
489 :     # Make a row for the matrix
490 :     sub dm_mat_row {
491 : lr003k 1127 my $elements = shift;
492 :     my $tmp = shift;
493 :     my @align = @{$tmp} ;
494 :     my %opts = @_;
495 :    
496 :     if($elements eq 'hline') {
497 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
498 :     return '\hline ';
499 :     } else {
500 :     # Making a hline in a table
501 :     return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>';
502 :     }
503 :     }
504 :    
505 :     my @elements = @{$elements};
506 :     my $out = "";
507 :     my ($brh, $erh) = ("",""); # Start and end raw html
508 :     my $element;
509 : jj 1319 my $colcount=0;
510 : lr003k 1127 if($main::displayMode eq 'Latex2HTML') {
511 :     $brh = "\\begin{rawhtml}";
512 :     $erh = "\\end{rawhtml}";
513 :     }
514 :     if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
515 :     while (@elements) {
516 : jj 1319 $colcount++;
517 :     $out .= '\fbox{' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
518 : lr003k 1127 $element= shift(@elements);
519 :     if(ref($element) eq 'Fraction') {
520 :     $element= $element->print_inline();
521 :     }
522 : jj 1494 $out .= '\\mbox{'."$element".'}';
523 : jj 1319 $out .= '}' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
524 :     $out .= " &";
525 : lr003k 1127 }
526 :     chop($out); # remove last &
527 :     $out .= "\\cr \n";
528 :     # carriage returns must be added manually for tex
529 :     } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
530 : dpvc 2267 or $main::displayMode eq 'HTML_jsMath'
531 :     or $main::displayMode eq 'HTML_asciimath'
532 : lr003k 1127 or $main::displayMode eq 'HTML_dpng'
533 :     or $main::displayMode eq 'HTML_img'
534 :     or $main::displayMode eq 'Latex2HTML') {
535 :     if(not $opts{'isfirst'}) { $out .= "$brh\n<TR>\n$erh";}
536 :     while (@elements) {
537 :     my $myalign;
538 :     $myalign = shift @align;
539 :     if($myalign eq "|" or $myalign eq "d") {
540 :     if($opts{'isfirst'} && $main::displayMode ne 'HTML_tth') {
541 :     $out .= $brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh;
542 :     $out .= dm_image_delimeter($opts{'isfirst'}-1, $myalign);
543 :     } elsif($main::displayMode eq 'HTML_tth') {
544 :     if($myalign eq "d") { # dashed line in tth mode
545 :     $out .= '<td> | </td>';
546 :     } elsif($opts{'isfirst'}) { # solid line in tth mode
547 :     $out .= '<td rowspan="'.$opts{'isfirst'}.'"<table border="0"><tr>';
548 :     $out .= dm_tth_delimeter($opts{'isfirst'}-1, "|");
549 :     $out .= '</td></tr></table>';
550 :     }
551 :     }
552 :     } else {
553 :     if($myalign eq "c") { $myalign = "center";}
554 :     if($myalign eq "l") { $myalign = "left";}
555 :     if($myalign eq "r") { $myalign = "right";}
556 : jj 1319 $colcount++;
557 :     $out .= '\fbox{' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
558 : lr003k 1127 $element= shift(@elements);
559 :     if (ref($element) eq 'Fraction') {
560 :     $element= $element->print_inline();
561 : lr003k 1505 #}elsif( $element =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ and $element != sprintf($opts{'num_format'},$element) and $element - sprintf($opts{'num_format'},$element) < $main::functZeroLevelTolDefault){
562 :     # $element = sprintf($opts{'num_format'},$element);
563 :     # $element = 0 if abs($element) < $main::functZeroLevelTolDefault;
564 : lr003k 1332 }
565 : jj 1319 $out .= "$brh<TD nowrap=\"nowrap\" align=\"$myalign\">$erh";
566 :     $out .= '<table border="1"><tr><td>' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
567 :     $out .= $element;
568 :     $out .= '</td></tr></table>' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
569 :     $out .= "$brh</TD>$erh";
570 : lr003k 1127 }
571 :     }
572 :     if(not $opts{'isfirst'}) {$out .="$brh</TR>$erh\n";}
573 :     }
574 :     else {
575 :     $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n";
576 :     }
577 :     $out;
578 : gage 1066 }
579 :    
580 :     =head4 mbox
581 :    
582 : lr003k 1127 Usage \{ mbox(thing1, thing2, thing3) \}
583 : gage 1066 \{ mbox([thing1, thing2, thing3], valign=>'top') \}
584 :    
585 :     mbox takes a list of constructs, such as strings, or outputs of
586 : lr003k 1127 display_matrix, and puts them together on a line. Without mbox, the
587 :     output of display_matrix would always start a new line.
588 : gage 1066
589 : lr003k 1127 The inputs can be just listed, or given as a reference to an array.
590 :     With the latter, optional arguments can be given.
591 : gage 1066
592 : lr003k 1127 Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX
593 :     output; and valign which sets vertical alignment on web page output.
594 : gage 1066
595 :     =cut
596 : lr003k 1127
597 : gage 1066 sub mbox {
598 : lr003k 1127 my $inList = shift;
599 :     my %opts;
600 :     if(ref($inList) eq 'ARRAY') {
601 :     %opts = @_;
602 :     } else {
603 :     %opts = ();
604 :     $inList = [$inList, @_];
605 :     }
606 : gage 1066
607 : lr003k 1127 set_default_options(\%opts,
608 :     '_filter_name' => 'mbox',
609 :     'valign' => 'middle',
610 :     'allowbreaks' => 'no',
611 :     'allow_unknown_options'=> 0);
612 :     if(! $opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';}
613 :     my $out = "";
614 :     my $j;
615 :     my ($brh, $erh) = ("",""); # Start and end raw html if needed
616 :     if($main::displayMode eq 'Latex2HTML') {
617 :     $brh = "\\begin{rawhtml}";
618 :     $erh = "\\end{rawhtml}";
619 :     }
620 :     my @hlist = @{$inList};
621 :     if($main::displayMode eq 'TeX') {
622 :     if($opts{allowbreaks} ne 'no') {$out .= '\mbox{';}
623 :     for $j (@hlist) { $out .= $j;}
624 :     if($opts{allowbreaks} ne 'no') {$out .= '}';}
625 :     } else {
626 :     $out .= qq!$brh<table><tr valign="$opts{'valign'}">$erh!;
627 :     for $j (@hlist) {
628 :     $out .= qq!$brh<td align="center" nowrap="nowrap">$erh$j$brh</td>$erh!;
629 :     }
630 :     $out .= "$brh</table>$erh";
631 :     }
632 :     return $out;
633 : gage 1066 }
634 : lr003k 1127
635 : gage 1066
636 : sh002i 1050 =head4 ra_flatten_matrix
637 :    
638 : lr003k 1127 Usage: ra_flatten_matrix($A)
639 :    
640 :     where $A is a matrix object
641 :     The output is a reference to an array. The matrix is placed in the array by iterating
642 :     over columns on the inside
643 :     loop, then over the rows. (e.g right to left and then down, as one reads text)
644 : sh002i 1050
645 :    
646 :     =cut
647 :    
648 :    
649 :     sub ra_flatten_matrix{
650 : lr003k 1127 my $matrix = shift;
651 :     warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/;
652 :     my @array = ();
653 :     my ($rows, $cols ) = $matrix->dim();
654 :     foreach my $i (1..$rows) {
655 :     foreach my $j (1..$cols) {
656 :     push(@array, $matrix->element($i,$j) );
657 :     }
658 :     }
659 :     \@array;
660 : sh002i 1050 }
661 :    
662 :     # This subroutine is probably obsolete and not generally useful. It was patterned after the APL
663 : jj 1097 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of
664 : sh002i 1050 # of matrices (e.g. mod 2) for indice matrices.
665 :     sub apl_matrix_mult{
666 : lr003k 1127 my $ra_a= shift;
667 :     my $ra_b= shift;
668 :     my %options = @_;
669 :     my $rf_op_times= sub {$_[0] *$_[1]};
670 :     my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; };
671 :     $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE';
672 :     $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE';
673 :     my $rows = @$ra_a;
674 :     my $cols = @{$ra_b->[0]};
675 :     my $k_size = @$ra_b;
676 :     my $out ;
677 :     my ($i, $j, $k);
678 :     for($i=0;$i<$rows;$i++) {
679 :     for($j=0;$j<$cols;$j++) {
680 :     my @r = ();
681 :     for($k=0;$k<$k_size;$k++) {
682 :     $r[$k] = &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]);
683 :     }
684 :     $out->[$i]->[$j] = &$rf_op_plus( @r );
685 :     }
686 :     }
687 :     $out;
688 : sh002i 1050 }
689 :    
690 :     sub matrix_mult {
691 : lr003k 1127 apl_matrix_mult($_[0], $_[1]);
692 : sh002i 1050 }
693 :    
694 :     sub make_matrix{
695 : lr003k 1127 my $function = shift;
696 :     my $rows = shift;
697 :     my $cols = shift;
698 :     my ($i, $j, $k);
699 :     my $ra_out;
700 :     for($i=0;$i<$rows;$i++) {
701 :     for($j=0;$j<$cols;$j++) {
702 :     $ra_out->[$i]->[$j] = &$function($i,$j);
703 :     }
704 :     }
705 :     $ra_out;
706 : sh002i 1050 }
707 :    
708 : lr003k 1127
709 : sh002i 1050 # sub format_answer{
710 : lr003k 1127 # my $ra_eigenvalues = shift;
711 :     # my $ra_eigenvectors = shift;
712 :     # my $functionName = shift;
713 :     # my @eigenvalues=@$ra_eigenvalues;
714 :     # my $size= @eigenvalues;
715 :     # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
716 :     # my $out = qq!
717 :     # $functionName(t) =! .
718 :     # displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen,
719 : sh002i 1050 # 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''},
720 :     # 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' }
721 :     # ) ) ;
722 :     # $out;
723 :     # }
724 :     # sub format_vector_answer{
725 : lr003k 1127 # my $ra_eigenvalues = shift;
726 :     # my $ra_eigenvectors = shift;
727 :     # my $functionName = shift;
728 :     # my @eigenvalues=@$ra_eigenvalues;
729 :     # my $size= @eigenvalues;
730 :     # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
731 :     # my $out = qq!
732 :     # $functionName(t) =! .
733 :     # displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ;
734 : sh002i 1050 # $out;
735 :     # }
736 :     # sub format_question{
737 : lr003k 1127 # my $ra_matrix = shift;
738 :     # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)!
739 : jj 1097 #
740 : sh002i 1050 # }
741 :    
742 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9