[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 3556 - (download) (as text) (annotate)
Tue Aug 23 23:59:46 2005 UTC (14 years, 4 months ago) by jj
File size: 31157 byte(s)
Fixed problem with display_matrix_mm so its behaviour matches its
documentation.  This may break problems which relied on its previous
incorrect behavior.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9