[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 1332 - (download) (as text) (annotate)
Wed Jul 9 20:29:04 2003 UTC (16 years, 7 months ago) by lr003k
File size: 30258 byte(s)
Fixed a rounding problem.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9