[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 4997 - (download) (as text) (annotate)
Mon Jun 11 18:16:40 2007 UTC (12 years, 7 months ago) by gage
File size: 31537 byte(s)
Fixing docementation so that it can be read from the web.

    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' or $main::displayMode eq 'HTML_tth'
  281                                          or $main::displayMode eq 'HTML_jsMath'
  282                                          or $main::displayMode eq 'HTML_asciimath'
  283                                          or $main::displayMode eq 'HTML_LaTeXMathML'
  284                                          or $main::displayMode eq 'HTML_dpng'
  285                                          or $main::displayMode eq 'HTML_img') {
  286                 $out .= qq!<TABLE BORDER="0" Cellspacing="8">\n!;
  287         }
  288         else {
  289                 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
  290                 }
  291         $out;
  292 }
  293 
  294 sub dm_special_tops {
  295         my %opts = @_;
  296         my @top_labels = @{$opts{'top_labels'}};
  297         my $out = '';
  298   my @alignList = @{$opts{'alignList'}};
  299         my ($j, $k);
  300         my ($brh, $erh) = ("",""); # Start and end raw html
  301         if($main::displayMode eq 'Latex2HTML') {
  302                 $brh = "\\begin{rawhtml}";
  303                 $erh = "\\end{rawhtml}";
  304         }
  305 
  306         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  307                 for $j (@top_labels) {
  308                         $out .= '\smash{\raisebox{2.9ex}{\ensuremath{'.
  309                                 $j . '}}} &';
  310                 }
  311                 chop($out); # remove last &
  312                 $out .= '\cr\noalign{\vskip -2.5ex}'."\n"; # want skip jump up 2.5ex
  313         } elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
  314                                          or $main::displayMode eq 'HTML_jsMath'
  315                                          or $main::displayMode eq 'HTML_asciimath'
  316                                          or $main::displayMode eq 'HTML_LaTeXMathML'
  317                                          or $main::displayMode eq 'HTML_dpng'
  318                                          or $main::displayMode eq 'HTML_img'
  319                                          or $main::displayMode eq 'Latex2HTML') {
  320                 $out .= "$brh<tr><td>$erh"; # Skip a column for the left brace
  321                 for $j (@top_labels) {
  322       $k = shift @alignList;
  323       while(defined($k) and ($k !~ /[lrc]/)) {
  324         $out .= "$brh<td></td>$erh";
  325         $k = shift @alignList;
  326       }
  327                         $out .= "$brh<td align=\"center\">$erh". ' \('.$j.'\)'."$brh</td>$erh";
  328                 }
  329     $out .= "<td></td>";
  330         } else {
  331                 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
  332         }
  333         return $out;
  334 }
  335 
  336 sub dm_mat_left {
  337         my $numrows = shift;
  338         my %opts = @_;
  339         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  340                 return ""; # left delim is built into begin matrix
  341         }
  342         my $out='';
  343         my $j;
  344         my ($brh, $erh) = ("",""); # Start and end raw html
  345         if($main::displayMode eq 'Latex2HTML') {
  346                 $brh = "\\begin{rawhtml}";
  347                 $erh = "\\end{rawhtml}";
  348         }
  349 
  350         if($main::displayMode eq 'HTML_dpng'
  351            or $main::displayMode eq 'HTML_jsMath'
  352                  or $main::displayMode eq 'HTML_asciimath'
  353        or $main::displayMode eq 'HTML_LaTeXMathML'
  354                  or $main::displayMode eq 'HTML_img'
  355                  or $main::displayMode eq 'Latex2HTML') {
  356                 $out .= "$brh<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">$erh";
  357                 $out .= dm_image_delimeter($numrows, $opts{'left'});
  358 #               $out .= "$brh<td><table border=0  cellspacing=5>\n$erh";
  359                 return $out;
  360         }
  361         # Mode is now tth
  362 
  363         $out .= "<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">";
  364         $out .= dm_tth_delimeter($numrows, $opts{'left'});
  365 #       $out .= "<td><table border=0  cellspacing=5>\n";
  366         return $out;
  367 }
  368 
  369 sub dm_mat_right {
  370         my $numrows = shift;
  371         my %opts = @_;
  372         my $out='';
  373         my $j;
  374         my ($brh, $erh) = ("",""); # Start and end raw html
  375         if($main::displayMode eq 'Latex2HTML') {
  376                 $brh = "\\begin{rawhtml}";
  377                 $erh = "\\end{rawhtml}";
  378         }
  379 
  380 
  381         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  382                 return "";
  383         }
  384 
  385         if($main::displayMode eq 'HTML_dpng'
  386                  or $main::displayMode eq 'HTML_jsMath'
  387                  or $main::displayMode eq 'HTML_asciimath'
  388            or $main::displayMode eq 'HTML_LaTeXMathML'
  389                  or $main::displayMode eq 'Latex2HTML'
  390                  or $main::displayMode eq 'HTML_img') {
  391                 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh";
  392 
  393                 $out.= dm_image_delimeter($numrows, $opts{'right'});
  394                 return $out;
  395         }
  396 
  397 #       $out .= "</table>";
  398   $out .= '<td nowrap="nowrap" align="left" rowspan="'.$numrows.'2">';
  399         $out .= dm_tth_delimeter($numrows, $opts{'right'});
  400   $out .= '</td>';
  401         return $out;
  402 }
  403 
  404 sub dm_end_matrix {
  405         my %opts = @_;
  406 
  407         my $out = "";
  408         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  409                 $out .= "\\end{array}\\right$opts{right}";
  410                 if($opts{'top_labels'}) {
  411                         $out .= '}} \dimen3=\ht3 \advance\dimen3 by 3ex \ht3=\dimen3'."\n".
  412                         '\box3\endgroup';
  413                 }
  414                 $out .= $opts{'force_tex'} ? '' : "\\) ";
  415         }
  416         elsif ($main::displayMode eq 'Latex2HTML') {
  417                 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
  418                 }
  419         elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
  420                            or $main::displayMode eq 'HTML_jsMath'
  421                                  or $main::displayMode eq 'HTML_asciimath'
  422                or $main::displayMode eq 'HTML_LaTeXMathML'
  423                                  or $main::displayMode eq 'HTML_img'
  424                                  or $main::displayMode eq 'HTML_dpng') {
  425                 $out .= "</TABLE>\n";
  426                 }
  427         else {
  428                 $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n";
  429                 }
  430         $out;
  431 }
  432 
  433 # Make an image of a big delimiter for a matrix
  434 sub dm_image_delimeter {
  435         my $numRows = shift;
  436         my $char = shift;
  437         my ($out, $j);
  438 
  439         if($char eq ".") {return("");}
  440         if($char eq "d") { # special treatment for dashed lines
  441                 $out='\(\vbox to '.($numRows*1.7).'\baselineskip ';
  442                 $out .='{\cleaders\hbox{\vbox{\hrule width0pt height3pt depth0pt';
  443                 $out .='\hrule width0.3pt height6pt depth0pt';
  444                 $out .='\hrule width0pt height3pt depth0pt}}\vfil}\)';
  445                 return($out);
  446         }
  447         if($char eq "|") {
  448                 $out='\(\vbox to '.($numRows*1.4).'\baselineskip ';
  449                 $out .='{\cleaders\vrule width0.3pt';
  450                 $out .='\vfil}\)';
  451                 return($out);
  452         }
  453         if($char eq "{") {$char = '\lbrace';}
  454         if($char eq "}") {$char = '\rbrace';}
  455         $out .= '\(\setlength{\arraycolsep}{0in}\left.\begin{array}{c}';
  456         for($j=0;$j<=$numRows;$j++)  { $out .= '\! \\\\'; }
  457         $out .= '\end{array}\right'.$char.'\)';
  458         return($out);
  459 }
  460 
  461 # Basically uses a table of special characters and simple
  462 # recipe to produce big delimeters a la tth mode
  463 sub dm_tth_delimeter {
  464         my $numRows = shift;
  465         my $char = shift;
  466 
  467         if($char eq ".") { return("");}
  468         my ($top, $mid, $bot, $extra);
  469         my ($j, $out);
  470 
  471         if($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         elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('','','','');}
  478         else { warn "Unknown delimiter in dm_tth_delimeter";}
  479 
  480         # old version
  481 #       $out = '<td nowrap="nowrap" align="left"><font face="symbol">';
  482         $out = '<font face="symbol">';
  483         $out .= "$top<br />";
  484         for($j=1;$j<$numRows; $j++) {
  485                 $out .= "$mid<br />";
  486         }
  487         $out .= "$extra<br />";
  488         for($j=1;$j<$numRows; $j++) {
  489                 $out .= "$mid<br />";
  490         }
  491         $out .= "$bot</font></td>";
  492         return $out;
  493 }
  494 
  495 # Make a row for the matrix
  496 sub dm_mat_row {
  497         my $elements = shift;
  498         my $tmp = shift;
  499         my @align =  @{$tmp} ;
  500         my %opts = @_;
  501 
  502         if($elements eq 'hline') {
  503                 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  504                         return '\hline ';
  505                 } else {
  506                         # Making a hline in a table
  507                         return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>';
  508                 }
  509         }
  510 
  511         my @elements = @{$elements};
  512         my $out = "";
  513         my ($brh, $erh) = ("",""); # Start and end raw html
  514         my $element;
  515         my $colcount=0;
  516         if($main::displayMode eq 'Latex2HTML') {
  517                 $brh = "\\begin{rawhtml}";
  518                 $erh = "\\end{rawhtml}";
  519         }
  520         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  521                 while (@elements) {
  522       $colcount++;
  523       $out .= '\fbox{' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'}  == $opts{'box'}->[0]);
  524                         $element= shift(@elements);
  525                         if(ref($element) eq 'Fraction') {
  526                                 $element=  $element->print_inline();
  527                         }
  528             if($opts{'force_tex'}) {
  529                           $out .= "$element";
  530             } else {
  531                           $out .= '\\mbox{'."$element".'}';
  532             }
  533             $out .= '}' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
  534                         $out .= " &";
  535                 }
  536                 chop($out); # remove last &
  537                 $out .= "\\cr  \n";
  538                  # carriage returns must be added manually for tex
  539                 }         elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
  540          or $main::displayMode eq 'HTML_jsMath'
  541          or $main::displayMode eq 'HTML_asciimath'
  542          or $main::displayMode eq 'HTML_LaTeXMathML'
  543                                  or $main::displayMode eq 'HTML_dpng'
  544                                  or $main::displayMode eq 'HTML_img'
  545                                  or $main::displayMode eq 'Latex2HTML') {
  546                         if(not $opts{'isfirst'}) {                $out .=  "$brh\n<TR>\n$erh";}
  547                 while (@elements) {
  548                         my $myalign;
  549                         $myalign = shift @align;
  550                         if($myalign eq "|" or $myalign eq "d") {
  551                                 if($opts{'isfirst'} && $main::displayMode ne 'HTML_tth') {
  552                                         $out .= $brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh;
  553                                         $out .= dm_image_delimeter($opts{'isfirst'}-1, $myalign);
  554                                 } elsif($main::displayMode eq 'HTML_tth') {
  555                                         if($myalign eq "d") { # dashed line in tth mode
  556                                                 $out .= '<td> | </td>';
  557                                         } elsif($opts{'isfirst'}) { # solid line in tth mode
  558                                                 $out .= '<td rowspan="'.$opts{'isfirst'}.'"<table border="0"><tr>';
  559                                                 $out .= dm_tth_delimeter($opts{'isfirst'}-1, "|");
  560                                                 $out .= '</td></tr></table>';
  561                                         }
  562                                 }
  563                         } else {
  564                                 if($myalign eq "c") { $myalign = "center";}
  565                                 if($myalign eq "l") { $myalign = "left";}
  566                                 if($myalign eq "r") { $myalign = "right";}
  567         $colcount++;
  568         $out .= '\fbox{' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
  569                                 $element= shift(@elements);
  570                                 if (ref($element) eq 'Fraction') {
  571                                         $element=  $element->print_inline();
  572                                 #}elsif( $element =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ and $element != sprintf($opts{'num_format'},$element) and $element - sprintf($opts{'num_format'},$element) < $main::functZeroLevelTolDefault){
  573         # $element = sprintf($opts{'num_format'},$element);
  574         # $element = 0 if abs($element) < $main::functZeroLevelTolDefault;
  575         }
  576                                 $out .= "$brh<TD nowrap=\"nowrap\" align=\"$myalign\">$erh";
  577                                 $out .= '<table border="1"><tr><td>' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
  578                                 $out .= $element;
  579                                 $out .= '</td></tr></table>' if ($colcount == $opts{'box'}->[1] and $opts{'cnt'} == $opts{'box'}->[0]);
  580         $out .= "$brh</TD>$erh";
  581                         }
  582                 }
  583                         if(not $opts{'isfirst'}) {$out .="$brh</TR>$erh\n";}
  584         }
  585         else {
  586                 $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n";
  587                 }
  588         $out;
  589 }
  590 
  591 =head4  mbox
  592 
  593                 Usage        \{ mbox(thing1, thing2, thing3) \}
  594           \{ mbox([thing1, thing2, thing3], valign=>'top') \}
  595 
  596     mbox takes a list of constructs, such as strings, or outputs of
  597           display_matrix, and puts them together on a line.  Without mbox, the
  598           output of display_matrix would always start a new line.
  599 
  600           The inputs can be just listed, or given as a reference to an array.
  601           With the latter, optional arguments can be given.
  602 
  603           Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX
  604           output; and valign which sets vertical alignment on web page output.
  605 
  606 =cut
  607 
  608 sub mbox {
  609         my $inList = shift;
  610         my %opts;
  611         if(ref($inList) eq 'ARRAY') {
  612                 %opts = @_;
  613         } else {
  614                 %opts = ();
  615                 $inList = [$inList, @_];
  616         }
  617 
  618         set_default_options(\%opts,
  619                                                                                         '_filter_name' => 'mbox',
  620                                                                                         'valign' => 'middle',
  621                                                                                         'allowbreaks' => 'no',
  622                                                                                         'allow_unknown_options'=> 0);
  623         if(! $opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';}
  624         my $out = "";
  625         my $j;
  626         my ($brh, $erh) = ("",""); # Start and end raw html if needed
  627         if($main::displayMode eq 'Latex2HTML') {
  628                 $brh = "\\begin{rawhtml}";
  629                 $erh = "\\end{rawhtml}";
  630         }
  631         my @hlist = @{$inList};
  632         if($main::displayMode eq 'TeX') {
  633                 if($opts{allowbreaks} ne 'no') {$out .= '\mbox{';}
  634                 for $j (@hlist) { $out .= $j;}
  635                 if($opts{allowbreaks} ne 'no') {$out .= '}';}
  636         } else {
  637                 $out .= qq!$brh<table><tr valign="$opts{'valign'}">$erh!;
  638                 for $j (@hlist) {
  639                         $out .= qq!$brh<td align="center" nowrap="nowrap">$erh$j$brh</td>$erh!;
  640                 }
  641                 $out .= "$brh</table>$erh";
  642         }
  643         return $out;
  644 }
  645 
  646 
  647 =head4   ra_flatten_matrix
  648 
  649                 Usage:   ra_flatten_matrix($A)
  650 
  651                         where $A is a matrix object
  652                         The output is a reference to an array.  The matrix is placed in the array by iterating
  653                         over  columns on the inside
  654                         loop, then over the rows. (e.g right to left and then down, as one reads text)
  655 
  656 
  657 =cut
  658 
  659 
  660 sub ra_flatten_matrix{
  661         my $matrix = shift;
  662         warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/;
  663         my @array = ();
  664         my ($rows, $cols ) = $matrix->dim();
  665         foreach my $i (1..$rows) {
  666                 foreach my $j (1..$cols) {
  667                         push(@array, $matrix->element($i,$j)  );
  668                 }
  669         }
  670         \@array;
  671 }
  672 
  673 # This subroutine is probably obsolete and not generally useful.  It was patterned after the APL
  674 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of
  675 # of matrices (e.g. mod 2) for indice matrices.
  676 sub apl_matrix_mult{
  677         my $ra_a= shift;
  678         my $ra_b= shift;
  679         my %options = @_;
  680         my $rf_op_times= sub {$_[0] *$_[1]};
  681         my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; };
  682         $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE';
  683         $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE';
  684         my $rows = @$ra_a;
  685         my $cols = @{$ra_b->[0]};
  686         my $k_size = @$ra_b;
  687         my $out ;
  688         my ($i, $j, $k);
  689         for($i=0;$i<$rows;$i++) {
  690                 for($j=0;$j<$cols;$j++) {
  691                     my @r = ();
  692                     for($k=0;$k<$k_size;$k++) {
  693                             $r[$k] =  &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]);
  694                     }
  695                         $out->[$i]->[$j] = &$rf_op_plus( @r );
  696                 }
  697         }
  698         $out;
  699 }
  700 
  701 sub matrix_mult {
  702         apl_matrix_mult($_[0], $_[1]);
  703 }
  704 
  705 sub make_matrix{
  706         my $function = shift;
  707         my $rows = shift;
  708         my $cols = shift;
  709         my ($i, $j, $k);
  710         my $ra_out;
  711         for($i=0;$i<$rows;$i++) {
  712                 for($j=0;$j<$cols;$j++) {
  713                         $ra_out->[$i]->[$j] = &$function($i,$j);
  714                 }
  715         }
  716         $ra_out;
  717 }
  718 
  719 
  720 # sub format_answer{
  721 #       my $ra_eigenvalues = shift;
  722 #       my $ra_eigenvectors = shift;
  723 #       my $functionName = shift;
  724 #       my @eigenvalues=@$ra_eigenvalues;
  725 #       my $size= @eigenvalues;
  726 #       my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
  727 #       my $out = qq!
  728 #                               $functionName(t) =! .
  729 #                                                   displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen,
  730 #                                     'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]"  : ''},
  731 #                                     'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' }
  732 #                                     ) ) ;
  733 #        $out;
  734 # }
  735 # sub format_vector_answer{
  736 #       my $ra_eigenvalues = shift;
  737 #       my $ra_eigenvectors = shift;
  738 #       my $functionName = shift;
  739 #       my @eigenvalues=@$ra_eigenvalues;
  740 #       my $size= @eigenvalues;
  741 #       my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
  742 #       my $out = qq!
  743 #                               $functionName(t) =! .
  744 #                                                   displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ;
  745 #        $out;
  746 # }
  747 # sub format_question{
  748 #       my $ra_matrix = shift;
  749 #       my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)!
  750 #
  751 # }
  752 
  753 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9