[system] / trunk / pg / macros / PGmorematrixmacros.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGmorematrixmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1265 - (download) (as text) (annotate)
Tue Jun 24 14:58:03 2003 UTC (16 years, 5 months ago) by lr003k
File size: 20528 byte(s)
Made the code more object-oriented

    1 #!/usr/local/bin/webwork-perl
    2 
    3 BEGIN{
    4   be_strict();
    5 }
    6 
    7 sub _PGmorematrixmacros_init{}
    8 
    9 sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix.
   10 
   11     warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)"
   12       if (@_ != 2);
   13     my $A = new Matrix($_[0],$_[1]);
   14     my $A_lr = new Matrix($_[0],$_[1]);
   15     my $det = 0;
   16     my $safety=0;
   17     while ($det == 0 and $safety < 6) {
   18         foreach my $i (1..$_[0]) {
   19             foreach my $j (1..$_[1]) {
   20                 $A->assign($i,$j,random(-9,9,1) );
   21                 }
   22             }
   23             $A_lr = $A->decompose_LR();
   24             $det = $A_lr->det_LR();
   25         }
   26     return $A;
   27 }
   28 
   29 sub swap_rows{
   30 
   31     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
   32       if (@_ != 3);
   33     my $matrix = $_[0];
   34     my ($i,$j) = ($_[1],$_[2]);
   35     warn "Error:  Rows to be swapped must exist!"
   36       if ($i>@$matrix or $j >@$matrix);
   37     warn "Warning:  Swapping the same row is pointless"
   38       if ($i==$j);
   39     my $cols = @{$matrix->[0]};
   40     my $B = new Matrix(@$matrix,$cols);
   41     foreach my $k (1..$cols){
   42         $B->assign($i,$k,element $matrix($j,$k));
   43         $B->assign($j,$k,element $matrix($i,$k));
   44     }
   45     return $B;
   46 }
   47 
   48 sub row_mult{
   49 
   50     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
   51       if (@_ != 3);
   52     my $matrix = $_[0];
   53     my ($scalar,$row) = ($_[1],$_[2]);
   54     warn "Undefined row multiplication"
   55       if ($row > @$matrix);
   56     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   57     foreach my $j (1..@{$matrix->[0]}) {
   58         $B->assign($row,$j,$scalar*element $matrix($row,$j));
   59     }
   60     return $B;
   61 }
   62 
   63 sub linear_combo{
   64 
   65     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
   66       if (@_ != 4);
   67     my $matrix = $_[0];
   68     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
   69     warn "Undefined row in multiplication"
   70       if ($row1>@$matrix or $row2>@$matrix);
   71     warn "Warning:  Using the same row"
   72       if ($row1==$row2);
   73     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   74     foreach my $j (1..@$matrix) {
   75         my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
   76         $B->assign($row2,$j,$scalar*$t1+$t2);
   77     }
   78     return $B;
   79 }
   80 
   81 =head3 basis_cmp()
   82 
   83 Compares a list of vectors by finding the change of coordinate matrix
   84 from the Prof's vectors to the students, and then taking the determinant of
   85 that to determine the existence of the change of coordinate matrix going the
   86 other way.
   87 
   88 ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
   89 
   90   1. a reference to an array of correct vectors
   91   2. a hash with the following keys (all optional):
   92     mode      --  'basis' (default) (only a basis allowed)
   93               'orthogonal' (only an orthogonal basis is allowed)
   94               'unit' (only unit vectors in the basis allowed)
   95               'orthonormal' (only orthogonal unit vectors in basis allowed)
   96     zeroLevelTol  --  absolute tolerance to allow when answer is close
   97                  to zero
   98 
   99     debug     --  if set to 1, provides verbose listing of
  100                 hash entries throughout fliters.
  101 
  102     help    --  'none' (default) (is quiet on all errors)
  103           'dim' (Tells student if wrong number of vectors are entered)
  104           'length' (Tells student if there is a vector of the wrong length)
  105           'orthogonal' (Tells student if their vectors are not orthogonal)
  106               (This is only in orthogonal mode)
  107           'unit' (Tells student if there is a vector not of unit length)
  108               (This is only in unit mode)
  109           'orthonormal' (Gives errors from orthogonal and orthonormal)
  110               (This is only in orthonormal mode)
  111           'verbose' (Gives all the above answer messages)
  112 
  113   Returns an answer evaluator.
  114 
  115 EXAMPLES:
  116 
  117   basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
  118                   --  correct answer is any basis for R^3.
  119   basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
  120                   --  correct answer is any orthonormal basis
  121                     for this space such as:
  122                     [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
  123 
  124 =cut
  125 
  126 
  127 sub basis_cmp {
  128   my $correctAnswer = shift;
  129   my %opt = @_;
  130 
  131   set_default_options(  \%opt,
  132         'zeroLevelTol'        =>  $main::functZeroLevelTolDefault,
  133               'debug'         =>  0,
  134         'mode'          =>  'basis',
  135         'help'          =>  'none',
  136       );
  137 
  138   # produce answer evaluator
  139   BASIS_CMP(
  140         'correct_ans'     =>  $correctAnswer,
  141         'zeroLevelTol'      =>  $opt{'zeroLevelTol'},
  142         'debug'       =>  $opt{'debug'},
  143         'mode'        =>  $opt{'mode'},
  144         'help'        =>  $opt{'help'},
  145   );
  146 }
  147 
  148 =head BASIS_CMP
  149 
  150 Made to keep the same format as num_cmp and fun_cmp.
  151 
  152 =cut
  153 
  154 sub BASIS_CMP {
  155   my %mat_params = @_;
  156   my $zeroLevelTol        = $mat_params{'zeroLevelTol'};
  157 
  158   # Check that everything is defined:
  159   $mat_params{debug} = 0 unless defined($mat_params{debug});
  160   $zeroLevelTol = $main::functZeroLevelTolDefault     unless defined $zeroLevelTol;
  161   $mat_params{'zeroLevelTol'}       =   $zeroLevelTol;
  162 
  163 ## This is where the correct answer should be checked someday.
  164   my $matrix          = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
  165 
  166 #construct the answer evaluator
  167   my $answer_evaluator = new AnswerEvaluator;
  168 
  169       $answer_evaluator->{debug} = $mat_params{debug};
  170   $answer_evaluator->ans_hash(  correct_ans     =>  pretty_print($mat_params{correct_ans}),
  171           rm_correct_ans    =>  $matrix,
  172           zeroLevelTol    =>  $mat_params{zeroLevelTol},
  173           debug     =>  $mat_params{debug},
  174           mode      =>  $mat_params{mode},
  175           help      =>  $mat_params{help},
  176       );
  177 
  178   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
  179     $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
  180     $rh_ans;
  181   });
  182   $answer_evaluator->install_pre_filter(sub{my $rh_ans = shift; my @options = @_;
  183     if( $rh_ans->{ans_label} =~ /ArRaY/ ){
  184       $rh_ans = ans_array_filter($rh_ans,@options);
  185       my @student_array = @{$rh_ans->{ra_student_ans}};
  186       my @array = ();
  187       for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
  188       {
  189         push( @array, Matrix->new_from_array_ref($student_array[$i]));
  190       }
  191       $rh_ans->{ra_student_ans} = \@array;
  192       $rh_ans;
  193     }else{
  194       $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
  195       vec_list_string($rh_ans,@options);
  196     }
  197 
  198   });#ra_student_ans is now the students answer as an array of vectors
  199   # anonymous subroutine to check dimension and length of the student vectors
  200   # if either is wrong, the answer is wrong.
  201   $answer_evaluator->install_pre_filter(sub{
  202     my $rh_ans = shift;
  203     my $length = $rh_ans->{rm_correct_ans}->[1];
  204     my $dim = $rh_ans->{rm_correct_ans}->[2];
  205     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  206     {
  207 
  208       $rh_ans->{score} = 0;
  209       if( $rh_ans->{help} =~ /dim|verbose/ )
  210       {
  211         $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  212       }else{
  213         $rh_ans->throw_error('EVAL');
  214       }
  215     }
  216     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  217     {
  218       if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  219       {
  220         $rh_ans->{score} = 0;
  221         if( $rh_ans->{help} =~ /length|verbose/ )
  222         {
  223           $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  224         }else{
  225           $rh_ans->throw_error('EVAL');
  226         }
  227       }
  228     }
  229     $rh_ans;
  230   });
  231   # Install prefilter for various modes
  232   if( $mat_params{mode} ne 'basis' )
  233   {
  234     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
  235     {
  236       $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  237     }
  238 
  239     if( $mat_params{mode} =~ /unit|orthonormal/ )
  240     {
  241       $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  242 
  243     }
  244   }
  245       $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
  246   $answer_evaluator->install_post_filter(
  247     sub {my $rh_ans = shift;
  248         if ($rh_ans->catch_error('SYNTAX') ) {
  249           $rh_ans->{ans_message} = $rh_ans->{error_message};
  250           $rh_ans->clear_error('SYNTAX');
  251         }
  252         if ($rh_ans->catch_error('EVAL') ) {
  253           $rh_ans->{ans_message} = $rh_ans->{error_message};
  254           $rh_ans->clear_error('EVAL');
  255         }
  256         $rh_ans;
  257     }
  258   );
  259   $answer_evaluator;
  260 }
  261 
  262 =head4 compare_basis
  263 
  264   compare_basis( $ans_hash, %options);
  265 
  266                 {ra_student_ans},     # a reference to the array of students answer vectors
  267                                {rm_correct_ans},      # a reference to the correct answer matrix
  268                                %options
  269                               )
  270 
  271 =cut
  272 
  273 sub compare_basis {
  274   my ($rh_ans, %options) = @_;
  275   my @ch_coord;
  276   my @vecs = @{$rh_ans->{ra_student_ans}};
  277 
  278   # A lot of the follosing code was taken from Matrix::proj_coeff
  279   # calling this method recursively would be a waste of time since
  280   # the prof's matrix never changes and solve_LR is an expensive
  281   # operation. This way it is only done once.
  282   my $matrix = $rh_ans->{rm_correct_ans};
  283   my ($dim,$x_vector, $base_matrix);
  284   my $errors = undef;
  285   my $lin_space_tr= ~ $matrix;
  286   $matrix = $lin_space_tr * $matrix;
  287   my $matrix_lr = $matrix->decompose_LR();
  288 
  289   #finds the coefficient vectors for each of the students vectors
  290   for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
  291   {
  292 
  293     $vecs[$i] = $lin_space_tr*$vecs[$i];
  294     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
  295     push( @ch_coord, $x_vector );
  296     $errors = "A unique adapted answer could not be determined.  Possibly the parameters have coefficient zero.<br>  dim = $dim base_matrix is $base_matrix\n" if $dim;  # only print if the dim is not zero.
  297   }
  298 
  299   if( defined($errors))
  300   {
  301     $rh_ans->throw_error('EVAL', $errors) ;
  302   }else{
  303     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
  304                   #existence of this matrix implies that
  305                   #the all of the students answers are a
  306                   #linear combo of the prof's
  307     $ch_coord_mat = $ch_coord_mat->decompose_LR();
  308 
  309     if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate  matrix is
  310                   # non-zero, this implies the existence of an inverse
  311                   # which implies all of the prof's vectors are a linear
  312                   # combo of the students vectors, showing containment
  313                   # both ways.
  314     {
  315       # I think sometimes if the students space has the same dimension as the profs space it
  316       # will get projected into the profs space even if it isn't a basis for that space.
  317       # this just checks that the prof's matrix times the change of coordinate matrix is actually
  318       #the students matrix
  319       if(  abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) - ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord))) < $options{zeroLevelTol} )
  320       {
  321         $rh_ans->{score} = 1;
  322       }else{
  323         $rh_ans->{score} = 0;
  324       }
  325     }
  326     else{
  327       $rh_ans->{score}=0;
  328     }
  329   }
  330   $rh_ans;
  331 
  332 }
  333 
  334 
  335 =head 2 vec_list_string
  336 
  337 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
  338 The student needs to enter vectors like:        [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
  339 Each entry can contain functions and operations and the usual math constants (pi and e).
  340 The vectors, however can not be added or multiplied or scalar multiplied by the student.
  341 Most errors are handled well. Any error in an entry is caught by the PG_answer_eval like it is in num_cmp or fun_cmp.
  342 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
  343 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
  344 later when the length of the vectors is checked.
  345 In the end, the method returns an array of Matrix objects.
  346 
  347 
  348 =cut
  349 
  350 sub vec_list_string{
  351   my $rh_ans = shift;
  352   my %options = @_;
  353   my $i;
  354   my $entry = "";
  355   my $char;
  356   my @paren_stack;
  357   my $length = length($rh_ans->{student_ans});
  358   my @temp;
  359   my $j = 0;
  360   my @answers;
  361   my $paren;
  362   my $display_ans;
  363 
  364   for( $i = 0; $i < $length ; $i++ )
  365   {
  366     $char = substr($rh_ans->{student_ans},$i,1);
  367 
  368     if( $char =~ /\(|\[|\{/ ){
  369         push( @paren_stack, $char )
  370     }
  371 
  372     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
  373     {
  374       if( $char !~ /,|\)|\]|\}/ ){
  375         $entry .= $char;
  376       }else{
  377         if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
  378         {
  379           if( length($entry) == 0 ){
  380             if( $char !~ /,/ ){
  381               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  382             }else{
  383                 $rh_ans->{preview_text_string}   .= ",";
  384                 $rh_ans->{preview_latex_string}  .= ",";
  385                 $display_ans .= ",";
  386             }
  387           }else{
  388 
  389             # This parser code was origianally taken from PGanswermacros::check_syntax
  390             # but parts of it needed to be slighty modified for this context
  391             my $parser = new AlgParserWithImplicitExpand;
  392             my $ret = $parser -> parse($entry);     #for use with loops
  393 
  394             if ( ref($ret) )  {   ## parsed successfully
  395               $parser -> tostring();
  396               $parser -> normalize();
  397               $entry = $parser -> tostring();
  398               $rh_ans->{preview_text_string} .= $entry.",";
  399               $rh_ans->{preview_latex_string} .=  $parser -> tolatex().",";
  400 
  401             } else {          ## error in parsing
  402 
  403               $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  404               $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  405               $rh_ans->{'preview_text_string'}  = '',
  406               $rh_ans->{'preview_latex_string'} = '',
  407               $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  408             }
  409 
  410             my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  411 
  412             if ($PG_eval_errors) {
  413               $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  414               $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  415               last;
  416             } else {
  417               $entry = prfmt($inVal,$options{format});
  418               $display_ans .= $entry.",";
  419               push(@temp , $entry);
  420             }
  421 
  422             if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
  423             {
  424               pop @paren_stack;
  425               chop($rh_ans->{preview_text_string});
  426               chop($rh_ans->{preview_latex_string});
  427               chop($display_ans);
  428               $rh_ans->{preview_text_string} .= "]";
  429               $rh_ans->{preview_latex_string} .= "]";
  430               $display_ans .= "]";
  431               if( scalar(@temp) > 0 )
  432               {
  433                 push( @answers,Matrix->new_from_col_vecs([\@temp]));
  434                 while(scalar(@temp) > 0 ){
  435                   pop @temp;
  436                 }
  437               }else{
  438                 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
  439               }
  440             }
  441           }
  442           $entry = "";
  443         }else{
  444           $paren = pop @paren_stack;
  445           if( scalar(@paren_stack) > 0 ){
  446             #this uses ASCII to check if the parens match up
  447             # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
  448             # ord ] = 93 , ord { = 123 , ord } = 125
  449             if( (ord($char) - ord($paren) <= 2) ){
  450               $entry = $entry . $char;
  451             }else{
  452               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  453             }
  454           }
  455         }
  456       }
  457     }else{
  458       $rh_ans->{preview_text_string}   .= "[";
  459       $rh_ans->{preview_latex_string}  .= "[";
  460       $display_ans .= "[";
  461     }
  462   }
  463   $rh_ans->{ra_student_ans} = \@answers;
  464   $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
  465   $rh_ans;
  466 }
  467 
  468 sub ans_array_filter{
  469   my $rh_ans = shift;
  470   my %options = @_;
  471   $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/;
  472   my $ans_num = $1;
  473   my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
  474   my $key;
  475   my @array = ();
  476   #my @latex = ();
  477   my ($i,$j,$k) = (0,0,0);
  478 
  479   #the keys aren't in order, so their info has to be put into the array before doing anything with it
  480   foreach $key (@keys){
  481     $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
  482     ($i,$j,$k) = ($1,$2,$3);
  483     $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
  484   }
  485 
  486   my $display_ans = "";
  487 
  488   for( $i=0; $i < scalar(@array) ; $i ++ )
  489   {
  490     $display_ans .= " [";
  491           $rh_ans->{preview_text_string} .= ' [';
  492           $rh_ans->{preview_latex_string} .= ' [';
  493     for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
  494     {
  495       $display_ans .= " [";
  496                   $rh_ans->{preview_text_string} .= ' [';
  497                   $rh_ans->{preview_latex_string} .= ' [';
  498       for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
  499         my $entry = $array[$i][$j][$k];
  500         $entry = math_constants($entry);
  501         # This parser code was origianally taken from PGanswermacros::check_syntax
  502         # but parts of it needed to be slighty modified for this context
  503         my $parser = new AlgParserWithImplicitExpand;
  504         my $ret = $parser -> parse($entry);     #for use with loops
  505 
  506         if ( ref($ret) )  {   ## parsed successfully
  507           $parser -> tostring();
  508           $parser -> normalize();
  509           $entry = $parser -> tostring();
  510           $rh_ans->{preview_text_string} .= $entry.",";
  511           $rh_ans->{preview_latex_string} .=  $parser -> tolatex().",";
  512           #$latex[$i][$j][$k] = "\\{".$parser -> tolatex()."\\}";
  513 
  514         } else {          ## error in parsing
  515           $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  516           $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  517           $rh_ans->{'preview_text_string'}  = '',
  518           $rh_ans->{'preview_latex_string'} = '',
  519           $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  520         }
  521 
  522         my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  523         if ($PG_eval_errors) {
  524           $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  525           $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  526           last;
  527         } else {
  528           $entry = prfmt($inVal,$options{format});
  529           $display_ans .= $entry.",";
  530           $array[$i][$j][$k] = $entry;
  531         }
  532       }
  533       chop($rh_ans->{preview_text_string});
  534       chop($rh_ans->{preview_latex_string});
  535       chop($display_ans);
  536                   $rh_ans->{preview_text_string} .= '] ,';
  537                   $rh_ans->{preview_latex_string} .= '] ,';
  538       $display_ans .= '] ,';
  539 
  540     }
  541     chop($rh_ans->{preview_text_string});
  542     chop($rh_ans->{preview_latex_string});
  543     chop($display_ans);
  544                 $rh_ans->{preview_text_string} .= '] ,';
  545                 $rh_ans->{preview_latex_string} .= '] ,';
  546     $display_ans .= '] ,';
  547   }
  548   chop($rh_ans->{preview_text_string});
  549   chop($rh_ans->{preview_latex_string});
  550   chop($display_ans);
  551 
  552   #for( $i = 0 ; $i < scalar( @latex ); $i++ ){
  553   # $latex[$i] = display_matrix($latex[$i]);
  554   #}
  555   #$rh_ans->{preview_latex_string} = mbox(\@latex);
  556   my @temp = ();
  557   for( $i = 0 ; $i < scalar( @array ); $i++ ){
  558     push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
  559     push @temp , "," unless $i == scalar(@array) - 1;
  560   }
  561   $rh_ans->{student_ans} = mbox(\@temp);
  562   $rh_ans->{ra_student_ans} = \@array;
  563 
  564   $rh_ans;
  565 
  566 }
  567 
  568 
  569 sub are_orthogonal_vecs{
  570   my ( $vec_ref,%opts ) = @_;
  571   my @vecs = ();
  572   if( ref($vec_ref) eq 'AnswerHash' )
  573   {
  574     @vecs = @{$vec_ref->{ra_student_ans}};
  575   }else{
  576     @vecs = @{$vec_ref};
  577   }
  578 
  579   my ($i,$j) = (0,0);
  580 
  581   my $num = scalar(@vecs);
  582   my $length = $vecs[0]->[1];
  583 
  584   for( ; $i < $num ; $i ++ )
  585   {
  586     for( $j = $i+1; $j < $num ; $j++ )
  587     {
  588       my $sum = 0;
  589       my $k = 0;
  590 
  591       for( ; $k < $length; $k++ ) {
  592         $sum += $vecs[$i]->[0][$k][0]*$vecs[$j]->[0][$k][0];
  593       }
  594 
  595       if( $sum > $main::functZeroLevelTolDefault )
  596       {
  597         if( ref( $vec_ref ) eq 'AnswerHash' ){
  598           $vec_ref->{score} = 0;
  599           if( $opts{help} =~ /orthogonal|orthonormal|verbose/ )
  600           {
  601             $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
  602           }else{
  603             $vec_ref->throw_error('EVAL');
  604           }
  605           return $vec_ref;
  606         }else{
  607           return 0;
  608         }
  609       }
  610     }
  611   }
  612   if( ref( $vec_ref ) eq 'AnswerHash' ){
  613     $vec_ref->{score} = 1;
  614     $vec_ref;
  615   }else{
  616     1;
  617   }
  618 }
  619 
  620 sub are_unit_vecs{
  621   my ( $vec_ref,%opts ) = @_;
  622   my @vecs = ();
  623   if( ref($vec_ref) eq 'AnswerHash' )
  624   {
  625     @vecs = @{$vec_ref->{ra_student_ans}};
  626   }else{
  627     @vecs = @{$vec_ref};
  628   }
  629 
  630   my $i = 0;
  631   my $num = scalar(@vecs);
  632   my $length = $vecs[0]->[1];
  633 
  634   for( ; $i < $num ; $i ++ )
  635   {
  636     my $sum = 0;
  637     my $k = 0;
  638 
  639     for( ; $k < $length; $k++ ) {
  640       $sum += $vecs[$i]->[0][$k][0]*$vecs[$i]->[0][$k][0];
  641     }
  642     if( abs(sqrt($sum) - 1) > $main::functZeroLevelTolDefault )
  643     {
  644       if( ref( $vec_ref ) eq 'AnswerHash' ){
  645         $vec_ref->{score} = 0;
  646         if( $opts{help} =~ /unit|orthonormal|verbose/ )
  647         {
  648           $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
  649         }else{
  650           $vec_ref->throw_error('EVAL');
  651         }
  652         return $vec_ref;
  653       }else{
  654         return 0;
  655       }
  656 
  657     }
  658   }
  659 
  660   if( ref( $vec_ref ) eq 'AnswerHash' ){
  661     $vec_ref->{score} = 1;
  662     $vec_ref;
  663   }else{
  664     1;
  665   }
  666 }
  667 
  668 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9