[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 1066 - (download) (as text) (annotate)
Mon Jun 9 00:54:33 2003 UTC (16 years, 8 months ago) by gage
File size: 22469 byte(s)
Adding a newer version of PGmatrixmacros.pl
--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9