[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 4386 - (download) (as text) (annotate)
Thu Aug 17 23:55:17 2006 UTC (13 years, 6 months ago) by dpvc
File size: 31536 byte(s)
Added LaTeXMathML mode.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9