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