[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 1127 - (download) (as text) (annotate)
Wed Jun 11 19:18:19 2003 UTC (16 years, 8 months ago) by lr003k
File size: 29207 byte(s)
Was working from an older copy before my last update, sorry.

    1 #!/usr/local/bin/webwork-perl
    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 tableaux, 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'=>0, # pair location of boxed element
  185                                                                                         'allow_unknown_options'=> 1);
  186 
  187         my ($numRows, $numCols, @myRows);
  188 
  189         if (ref($ra_matrix) eq 'Matrix' )  {
  190                 ($numRows, $numCols) = $ra_matrix->dim();
  191                 for( my $i=0; $i<$numRows; $i++) {
  192                         $myRows[$i] = [];
  193                         for (my $j=0; $j<$numCols; $j++) {
  194                                 my $entry = $ra_matrix->element($i+1,$j+1);
  195                                 $entry = "#" unless defined($entry);
  196                                 push @{ $myRows[$i] },  $entry;
  197                         }
  198                 }
  199         } else { # matrix is input as [ [1,2,3],[4,5,6]]
  200                 $numCols = 0;
  201                 @myRows = @{$ra_matrix};
  202                 $numRows = scalar(@myRows); # counts horizontal rules too
  203                 my $tmp;
  204                 for $tmp (@myRows) {
  205                         if($tmp ne 'hline') {
  206                                 my @arow = @{$tmp};
  207                                 $numCols= scalar(@arow);   #number of columns in table
  208                                 last;
  209                         }
  210                 }
  211         }
  212         my ($boxrow,$boxcol) = (-1,-1); #default to impossible values so nothing is boxed
  213         if($opts{'box'}) {
  214                 $boxrow = $opts{'box'}->[0];
  215                 $boxcol = $opts{'box'}->[1];
  216         }
  217 
  218 
  219         my $out;
  220         my $j;
  221         my $alignString=''; # alignment as a string for dvi/pdf
  222         my $alignList;      # alignment as a list
  223 
  224         if(defined($opts{'align'})) {
  225                 $alignString= $opts{'align'};
  226                 $alignString =~ s/v/$opts{'midrule'}/g;
  227                 $alignString =~ tr/s/|/; # Treat "s" as "|"
  228                 $alignString =~ tr/n//;  # Remove "n" altogether
  229                 @$alignList = split //, $alignString;
  230         } else {
  231                 for($j=0; $j<$numCols; $j++) {
  232                         $alignList->[$j] = "c";
  233                         $alignString .= "c";
  234                 }
  235         }
  236         # Before we start, we cannot let top_labels proceed if we
  237         # are in tth mode and force_tex is true since tth can't handle
  238         # the resulting code
  239         if($opts{'force_tex'} and $main::displayMode eq 'HTML_tth') {
  240                 $opts{'top_labels'} = 0;
  241         }
  242 
  243         $out .= dm_begin_matrix($alignString, %opts);
  244         # column labels for linear programming
  245         $out .= dm_special_tops(%opts) if ($opts{'top_labels'});
  246         $out .= dm_mat_left($numRows, %opts);
  247         # vertical lines put in with first row
  248         $j = shift @myRows;
  249         $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows);
  250         $out .= dm_mat_right($numRows, %opts);
  251         for $j (@myRows) {
  252                 $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>0);
  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 $ncols = scalar(@top_labels);
  294         my $out = '';
  295         my $j;
  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                         $out .= "$brh<td>$erh". ' \('.$j.'\)'."$brh</td>$erh";
  316                 }
  317         } else {
  318                 $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n";
  319         }
  320         return $out;
  321 }
  322 
  323 sub dm_mat_left {
  324         my $numrows = shift;
  325         my %opts = @_;
  326         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  327                 return ""; # left delim is built into begin matrix
  328         }
  329         my $out='';
  330         my $j;
  331         my ($brh, $erh) = ("",""); # Start and end raw html
  332         if($main::displayMode eq 'Latex2HTML') {
  333                 $brh = "\\begin{rawhtml}";
  334                 $erh = "\\end{rawhtml}";
  335         }
  336 
  337         if($main::displayMode eq 'HTML_dpng'
  338                  or $main::displayMode eq 'HTML_img'
  339                  or $main::displayMode eq 'Latex2HTML') {
  340                 $out .= "$brh<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">$erh";
  341                 $out .= dm_image_delimeter($numrows, $opts{'left'});
  342 #               $out .= "$brh<td><table border=0  cellspacing=5>\n$erh";
  343                 return $out;
  344         }
  345         # Mode is now tth
  346 
  347         $out .= "<tr valign=\"center\"><td nowrap=\"nowrap\" align=\"left\" rowspan=\"$numrows\">";
  348         $out .= dm_tth_delimeter($numrows, $opts{'left'});
  349 #       $out .= "<td><table border=0  cellspacing=5>\n";
  350         return $out;
  351 }
  352 
  353 sub dm_mat_right {
  354         my $numrows = shift;
  355         my %opts = @_;
  356         my $out='';
  357         my $j;
  358         my ($brh, $erh) = ("",""); # Start and end raw html
  359         if($main::displayMode eq 'Latex2HTML') {
  360                 $brh = "\\begin{rawhtml}";
  361                 $erh = "\\end{rawhtml}";
  362         }
  363 
  364 
  365         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  366                 return "";
  367         }
  368 
  369         if($main::displayMode eq 'HTML_dpng'
  370                  or $main::displayMode eq 'Latex2HTML'
  371                  or $main::displayMode eq 'HTML_dpng') {
  372                 $out .= "$brh<td nowrap=\"nowrap\" align=\"right\" rowspan=\"$numrows\">$erh";
  373 
  374                 $out.= dm_image_delimeter($numrows, $opts{'right'});
  375                 return $out;
  376         }
  377 
  378 #       $out .= "</table>";
  379   $out .= '<td nowrap="nowrap" align="left" rowspan="'.$numrows.'2">';
  380         $out .= dm_tth_delimeter($numrows, $opts{'right'});
  381   $out .= '</td>';
  382         return $out;
  383 }
  384 
  385 sub dm_end_matrix {
  386         my %opts = @_;
  387 
  388         my $out = "";
  389         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  390                 $out .= "\\end{array}\\right$opts{right}";
  391                 $out .= $opts{'force_tex'} ? '' : "\\) ";
  392                 if($opts{'top_labels'}) {
  393                         $out .= '}} \dimen3=\ht3 \advance\dimen3 by 3ex \ht3=\dimen3'."\n".
  394                         '\box3\endgroup';
  395                 }
  396         }
  397         elsif ($main::displayMode eq 'Latex2HTML') {
  398                 $out .= "\n\\begin{rawhtml} </TABLE >\n\\end{rawhtml}";
  399                 }
  400         elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
  401                                  or $main::displayMode eq 'HTML_img'
  402                                  or $main::displayMode eq 'HTML_dpng') {
  403                 $out .= "</TABLE>\n";
  404                 }
  405         else {
  406                 $out = "Error: PGmatrixmacros: dm_end_matrix: Unknown displayMode: $main::displayMode.\n";
  407                 }
  408         $out;
  409 }
  410 
  411 # Make an image of a big delimiter for a matrix
  412 sub dm_image_delimeter {
  413         my $numRows = shift;
  414         my $char = shift;
  415         my ($out, $j);
  416 
  417         if($char eq ".") {return("");}
  418         if($char eq "d") { # special treatment for dashed lines
  419                 $out='\(\vbox to '.($numRows*1.7).'\baselineskip ';
  420                 $out .='{\cleaders\hbox{\vbox{\hrule width0pt height3pt depth0pt';
  421                 $out .='\hrule width0.3pt height6pt depth0pt';
  422                 $out .='\hrule width0pt height3pt depth0pt}}\vfil}\)';
  423                 return($out);
  424         }
  425         if($char eq "|") {
  426                 $out='\(\vbox to '.($numRows*1.4).'\baselineskip ';
  427                 $out .='{\cleaders\vrule width0.3pt';
  428                 $out .='\vfil}\)';
  429                 return($out);
  430         }
  431         if($char eq "{") {$char = '\lbrace';}
  432         if($char eq "}") {$char = '\rbrace';}
  433         $out .= '\(\setlength{\arraycolsep}{0in}\left.\begin{array}{c}';
  434         for($j=0;$j<=$numRows;$j++)  { $out .= '\! \\\\'; }
  435         $out .= '\end{array}\right'.$char.'\)';
  436         return($out);
  437 }
  438 
  439 # Basically uses a table of special characters and simple
  440 # recipe to produce big delimeters a la tth mode
  441 sub dm_tth_delimeter {
  442         my $numRows = shift;
  443         my $char = shift;
  444 
  445         if($char eq ".") { return("");}
  446         my ($top, $mid, $bot, $extra);
  447         my ($j, $out);
  448 
  449         if($char eq "(") { ($top, $mid, $bot, $extra) = ('','','','');}
  450         elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('','','','');}
  451         elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('','','','');}
  452         elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('','','','');}
  453         elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('','','','');}
  454         elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('','','','');}
  455         elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('','','','');}
  456         else { warn "Unknown delimiter in dm_tth_delimeter";}
  457 
  458         # old version
  459 #       $out = '<td nowrap="nowrap" align="left"><font face="symbol">';
  460         $out = '<font face="symbol">';
  461         $out .= "$top<br />";
  462         for($j=1;$j<$numRows; $j++) {
  463                 $out .= "$mid<br />";
  464         }
  465         $out .= "$extra<br />";
  466         for($j=1;$j<$numRows; $j++) {
  467                 $out .= "$mid<br />";
  468         }
  469         $out .= "$bot</font></td>";
  470         return $out;
  471 }
  472 
  473 # Make a row for the matrix
  474 sub dm_mat_row {
  475         my $elements = shift;
  476         my $tmp = shift;
  477         my @align =  @{$tmp} ;
  478         my %opts = @_;
  479 
  480         if($elements eq 'hline') {
  481                 if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  482                         return '\hline ';
  483                 } else {
  484                         # Making a hline in a table
  485                         return '<tr><td colspan="'.scalar(@align).'"><hr></td></tr>';
  486                 }
  487         }
  488 
  489         my @elements = @{$elements};
  490         my $out = "";
  491         my ($brh, $erh) = ("",""); # Start and end raw html
  492         my $element;
  493         if($main::displayMode eq 'Latex2HTML') {
  494                 $brh = "\\begin{rawhtml}";
  495                 $erh = "\\end{rawhtml}";
  496         }
  497         if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) {
  498                 while (@elements) {
  499                         $element= shift(@elements);
  500                         if(ref($element) eq 'Fraction') {
  501                                 $element=  $element->print_inline();
  502                         }
  503                         $out .= "$element &";
  504                 }
  505                 chop($out); # remove last &
  506                 $out .= "\\cr  \n";
  507                  # carriage returns must be added manually for tex
  508                 }         elsif ($main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_tth'
  509                                  or $main::displayMode eq 'HTML_dpng'
  510                                  or $main::displayMode eq 'HTML_img'
  511                                  or $main::displayMode eq 'Latex2HTML') {
  512                         if(not $opts{'isfirst'}) {                $out .=  "$brh\n<TR>\n$erh";}
  513                 while (@elements) {
  514                         my $myalign;
  515                         $myalign = shift @align;
  516                         if($myalign eq "|" or $myalign eq "d") {
  517                                 if($opts{'isfirst'} && $main::displayMode ne 'HTML_tth') {
  518                                         $out .= $brh.'<td rowspan="'.$opts{'isfirst'}.'">'.$erh;
  519                                         $out .= dm_image_delimeter($opts{'isfirst'}-1, $myalign);
  520                                 } elsif($main::displayMode eq 'HTML_tth') {
  521                                         if($myalign eq "d") { # dashed line in tth mode
  522                                                 $out .= '<td> | </td>';
  523                                         } elsif($opts{'isfirst'}) { # solid line in tth mode
  524                                                 $out .= '<td rowspan="'.$opts{'isfirst'}.'"<table border="0"><tr>';
  525                                                 $out .= dm_tth_delimeter($opts{'isfirst'}-1, "|");
  526                                                 $out .= '</td></tr></table>';
  527                                         }
  528                                 }
  529                         } else {
  530                                 if($myalign eq "c") { $myalign = "center";}
  531                                 if($myalign eq "l") { $myalign = "left";}
  532                                 if($myalign eq "r") { $myalign = "right";}
  533                                 $element= shift(@elements);
  534                                 if (ref($element) eq 'Fraction') {
  535                                         $element=  $element->print_inline();
  536                                 }
  537                                 $out .= "$brh<TD nowrap=\"nowrap\" align=\"$myalign\">$erh" .
  538                                                                                                                                                                  $element . "$brh</TD>$erh";
  539                         }
  540                 }
  541                         if(not $opts{'isfirst'}) {$out .="$brh</TR>$erh\n";}
  542         }
  543         else {
  544                 $out = "Error: dm_mat_row: Unknown displayMode: $main::displayMode.\n";
  545                 }
  546         $out;
  547 }
  548 
  549 =head4  mbox
  550 
  551                 Usage        \{ mbox(thing1, thing2, thing3) \}
  552           \{ mbox([thing1, thing2, thing3], valign=>'top') \}
  553 
  554     mbox takes a list of constructs, such as strings, or outputs of
  555           display_matrix, and puts them together on a line.  Without mbox, the
  556           output of display_matrix would always start a new line.
  557 
  558           The inputs can be just listed, or given as a reference to an array.
  559           With the latter, optional arguments can be given.
  560 
  561           Optional arguments are allowbreaks=>'yes' to allow line breaks in TeX
  562           output; and valign which sets vertical alignment on web page output.
  563 
  564 =cut
  565 
  566 sub mbox {
  567         my $inList = shift;
  568         my %opts;
  569         if(ref($inList) eq 'ARRAY') {
  570                 %opts = @_;
  571         } else {
  572                 %opts = ();
  573                 $inList = [$inList, @_];
  574         }
  575 
  576         set_default_options(\%opts,
  577                                                                                         '_filter_name' => 'mbox',
  578                                                                                         'valign' => 'middle',
  579                                                                                         'allowbreaks' => 'no',
  580                                                                                         'allow_unknown_options'=> 0);
  581         if(! $opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';}
  582         my $out = "";
  583         my $j;
  584         my ($brh, $erh) = ("",""); # Start and end raw html if needed
  585         if($main::displayMode eq 'Latex2HTML') {
  586                 $brh = "\\begin{rawhtml}";
  587                 $erh = "\\end{rawhtml}";
  588         }
  589         my @hlist = @{$inList};
  590         if($main::displayMode eq 'TeX') {
  591                 if($opts{allowbreaks} ne 'no') {$out .= '\mbox{';}
  592                 for $j (@hlist) { $out .= $j;}
  593                 if($opts{allowbreaks} ne 'no') {$out .= '}';}
  594         } else {
  595                 $out .= qq!$brh<table><tr valign="$opts{'valign'}">$erh!;
  596                 for $j (@hlist) {
  597                         $out .= qq!$brh<td align="center" nowrap="nowrap">$erh$j$brh</td>$erh!;
  598                 }
  599                 $out .= "$brh</table>$erh";
  600         }
  601         return $out;
  602 }
  603 
  604 
  605 =head4   ra_flatten_matrix
  606 
  607                 Usage:   ra_flatten_matrix($A)
  608 
  609                         where $A is a matrix object
  610                         The output is a reference to an array.  The matrix is placed in the array by iterating
  611                         over  columns on the inside
  612                         loop, then over the rows. (e.g right to left and then down, as one reads text)
  613 
  614 
  615 =cut
  616 
  617 
  618 sub ra_flatten_matrix{
  619         my $matrix = shift;
  620         warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/;
  621         my @array = ();
  622         my ($rows, $cols ) = $matrix->dim();
  623         foreach my $i (1..$rows) {
  624                 foreach my $j (1..$cols) {
  625                         push(@array, $matrix->element($i,$j)  );
  626                 }
  627         }
  628         \@array;
  629 }
  630 
  631 # This subroutine is probably obsolete and not generally useful.  It was patterned after the APL
  632 # constructs for multiplying matrices. It might come in handy for non-standard multiplication of
  633 # of matrices (e.g. mod 2) for indice matrices.
  634 sub apl_matrix_mult{
  635         my $ra_a= shift;
  636         my $ra_b= shift;
  637         my %options = @_;
  638         my $rf_op_times= sub {$_[0] *$_[1]};
  639         my $rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){ $sum = $sum + shift(@in) } $sum; };
  640         $rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE';
  641         $rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE';
  642         my $rows = @$ra_a;
  643         my $cols = @{$ra_b->[0]};
  644         my $k_size = @$ra_b;
  645         my $out ;
  646         my ($i, $j, $k);
  647         for($i=0;$i<$rows;$i++) {
  648                 for($j=0;$j<$cols;$j++) {
  649                     my @r = ();
  650                     for($k=0;$k<$k_size;$k++) {
  651                             $r[$k] =  &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]);
  652                     }
  653                         $out->[$i]->[$j] = &$rf_op_plus( @r );
  654                 }
  655         }
  656         $out;
  657 }
  658 
  659 sub matrix_mult {
  660         apl_matrix_mult($_[0], $_[1]);
  661 }
  662 
  663 sub make_matrix{
  664         my $function = shift;
  665         my $rows = shift;
  666         my $cols = shift;
  667         my ($i, $j, $k);
  668         my $ra_out;
  669         for($i=0;$i<$rows;$i++) {
  670                 for($j=0;$j<$cols;$j++) {
  671                         $ra_out->[$i]->[$j] = &$function($i,$j);
  672                 }
  673         }
  674         $ra_out;
  675 }
  676 
  677 
  678 # sub format_answer{
  679 #       my $ra_eigenvalues = shift;
  680 #       my $ra_eigenvectors = shift;
  681 #       my $functionName = shift;
  682 #       my @eigenvalues=@$ra_eigenvalues;
  683 #       my $size= @eigenvalues;
  684 #       my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
  685 #       my $out = qq!
  686 #                               $functionName(t) =! .
  687 #                                                   displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen,
  688 #                                     'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]"  : ''},
  689 #                                     'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' }
  690 #                                     ) ) ;
  691 #        $out;
  692 # }
  693 # sub format_vector_answer{
  694 #       my $ra_eigenvalues = shift;
  695 #       my $ra_eigenvectors = shift;
  696 #       my $functionName = shift;
  697 #       my @eigenvalues=@$ra_eigenvalues;
  698 #       my $size= @eigenvalues;
  699 #       my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size);
  700 #       my $out = qq!
  701 #                               $functionName(t) =! .
  702 #                                                   displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ;
  703 #        $out;
  704 # }
  705 # sub format_question{
  706 #       my $ra_matrix = shift;
  707 #       my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)!
  708 #
  709 # }
  710 
  711 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9