[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 1278 - (download) (as text) (annotate)
Thu Jun 26 13:55:43 2003 UTC (16 years, 7 months ago) by lr003k
File size: 20366 byte(s)
Matrices now displayed in previewer.

    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     =>  display_correct_vecs($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 ($i,$j,$k) = (0,0,0);
  477 
  478   #the keys aren't in order, so their info has to be put into the array before doing anything with it
  479   foreach $key (@keys){
  480     $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
  481     ($i,$j,$k) = ($1,$2,$3);
  482     $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
  483   }
  484 
  485   my $display_ans = "";
  486 
  487   for( $i=0; $i < scalar(@array) ; $i ++ )
  488   {
  489     $display_ans .= " [";
  490           $rh_ans->{preview_text_string} .= ' [';
  491           $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
  492     for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
  493     {
  494       $display_ans .= " [";
  495                   $rh_ans->{preview_text_string} .= ' [';
  496                   for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
  497         my $entry = $array[$i][$j][$k];
  498         $entry = math_constants($entry);
  499         # This parser code was origianally taken from PGanswermacros::check_syntax
  500         # but parts of it needed to be slighty modified for this context
  501         my $parser = new AlgParserWithImplicitExpand;
  502         my $ret = $parser -> parse($entry);     #for use with loops
  503 
  504         if ( ref($ret) )  {   ## parsed successfully
  505           $parser -> tostring();
  506           $parser -> normalize();
  507           $entry = $parser -> tostring();
  508           $rh_ans->{preview_text_string} .= $entry.",";
  509           $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
  510 
  511         } else {          ## error in parsing
  512           $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  513           $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  514           $rh_ans->{'preview_text_string'}  = '',
  515           $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  516         }
  517 
  518         my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  519         if ($PG_eval_errors) {
  520           $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  521           $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  522           last;
  523         } else {
  524           $entry = prfmt($inVal,$options{format});
  525           $display_ans .= $entry.",";
  526           $array[$i][$j][$k] = $entry;
  527         }
  528       }
  529       chop($rh_ans->{preview_text_string});
  530       chop($display_ans);
  531                   $rh_ans->{preview_text_string} .= '] ,';
  532                  $rh_ans->{preview_latex_string} .= '\\\\';
  533       $display_ans .= '] ,';
  534 
  535     }
  536     chop($rh_ans->{preview_text_string});
  537     chop($display_ans);
  538                 $rh_ans->{preview_text_string} .= '] ,';
  539                 $rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
  540     $display_ans .= '] ,';
  541   }
  542   chop($rh_ans->{preview_text_string});
  543   chop($rh_ans->{preview_latex_string});
  544   chop($rh_ans->{preview_latex_string});
  545   chop($rh_ans->{preview_latex_string});
  546   chop($display_ans);
  547 
  548   my @temp = ();
  549   for( $i = 0 ; $i < scalar( @array ); $i++ ){
  550     push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
  551     push @temp , "," unless $i == scalar(@array) - 1;
  552   }
  553   $rh_ans->{student_ans} = mbox(\@temp);
  554   $rh_ans->{ra_student_ans} = \@array;
  555 
  556   $rh_ans;
  557 
  558 }
  559 
  560 
  561 sub are_orthogonal_vecs{
  562   my ($vec_ref , %opts) = @_;
  563   my @vecs = ();
  564   if( ref($vec_ref) eq 'AnswerHash' )
  565   {
  566     @vecs = @{$vec_ref->{ra_student_ans}};
  567   }else{
  568     @vecs = @{$vec_ref};
  569   }
  570   my ($i,$j) = (0,0);
  571 
  572   my $num = scalar(@vecs);
  573   my $length = $vecs[0]->[1];
  574 
  575   for( ; $i < $num ; $i ++ )
  576   {
  577     for( $j = $i+1; $j < $num ; $j++ )
  578     {
  579       if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault )
  580       {
  581         if( ref( $vec_ref ) eq 'AnswerHash' ){
  582           $vec_ref->{score} = 0;
  583           if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
  584           {
  585             $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
  586           }else{
  587             $vec_ref->throw_error('EVAL');
  588           }
  589           return $vec_ref;
  590         }else{
  591           return 0;
  592         }
  593       }
  594     }
  595   }
  596   if( ref( $vec_ref ) eq 'AnswerHash' ){
  597     $vec_ref->{score} = 1;
  598     $vec_ref;
  599   }else{
  600     1;
  601   }
  602 }
  603 
  604 sub are_unit_vecs{
  605   my ( $vec_ref,%opts ) = @_;
  606   my @vecs = ();
  607   if( ref($vec_ref) eq 'AnswerHash' )
  608   {
  609     @vecs = @{$vec_ref->{ra_student_ans}};
  610   }else{
  611     @vecs = @{$vec_ref};
  612   }
  613 
  614   my $i = 0;
  615   my $num = scalar(@vecs);
  616   my $length = $vecs[0]->[1];
  617 
  618   for( ; $i < $num ; $i ++ )
  619   {
  620     if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
  621     {
  622       if( ref( $vec_ref ) eq 'AnswerHash' ){
  623         $vec_ref->{score} = 0;
  624         if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
  625         {
  626           $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
  627         }else{
  628           $vec_ref->throw_error('EVAL');
  629         }
  630         return $vec_ref;
  631       }else{
  632         return 0;
  633       }
  634 
  635     }
  636   }
  637 
  638   if( ref( $vec_ref ) eq 'AnswerHash' ){
  639     $vec_ref->{score} = 1;
  640     $vec_ref;
  641   }else{
  642     1;
  643   }
  644 }
  645 
  646 sub display_correct_vecs{
  647   my ( $ra_vecs,%opts ) = @_;
  648   my @ra_vecs = @{$ra_vecs};
  649   my @temp = ();
  650 
  651   for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ){
  652     push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
  653     push @temp, ",";
  654   }
  655 
  656   pop @temp;
  657 
  658   mbox(\@temp);
  659 
  660 }
  661 
  662 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9