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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6889 - (download) (as text) (annotate)
Fri Jun 24 00:07:08 2011 UTC (8 years, 7 months ago) by apizer
File size: 30580 byte(s)
Implemented Davide's fix so that MathJax works with matrix delimiters

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9