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