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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4997 - (download) (as text) (annotate)
Mon Jun 11 18:16:40 2007 UTC (12 years, 8 months ago) by gage
File size: 22717 byte(s)
Fixing docementation so that it can be read from the web.

    1 # This file     is PGcomplexmacros.pl
    2 # This includes the subroutines for the ANS macros, that
    3 # is, macros allowing a more flexible answer checking
    4 ####################################################################
    5 # Copyright @ 1995-2002 The WeBWorK Team
    6 # All Rights Reserved
    7 ####################################################################
    8 #$Id$
    9 
   10 
   11 =head1 NAME
   12 
   13   Macros for complex numbers for the PG language
   14 
   15 =head1 SYNPOSIS
   16 
   17 
   18 
   19 =head1 DESCRIPTION
   20 
   21 =cut
   22 
   23 
   24 BEGIN{
   25   be_strict();
   26 
   27 }
   28 
   29 
   30 
   31 sub _PGcomplexmacros_init {
   32 }
   33 # export functions from Complex1.
   34 
   35 foreach my $f (@Complex1::EXPORT) {
   36 #   #PG_restricted_eval("\*$f = \*Complex1::$f"); # this is too clever --
   37                                                   # the original subroutines are destroyed
   38 #         next if $f eq 'sqrt';  #exporting the square root caused conflicts with the standard version
   39 #                                   # You can still use Complex1::sqrt to take square root of complex numbers
   40 #         next if $f eq 'log';  #exporting loq caused conflicts with the standard version
   41 #                               # You can still use Complex1::log to take square root of complex numbers
   42 
   43   next if $f eq 'i' || $f eq 'pi';
   44   my $code = PG_restricted_eval("\\&CommonFunction::$f");
   45   if (defined($code) && defined(&{$code})) {
   46     $CommonFunction::function{$f} = "Complex1::$f";  # PGcommonMacros now takes care of this.
   47   } else {
   48     my $string = qq{sub main::$f {&Complex1::$f}};
   49     PG_restricted_eval($string);
   50   }
   51 
   52 }
   53 
   54 
   55 # You need to add
   56 # sub i();  # to your problem or else to dangerousMacros.pl
   57 # in order to use expressions such as 1 +3*i;
   58 # Without this prototype you would have to write 1+3*i();
   59 # The prototype has to be defined at compile time, but dangerousMacros.pl is complied first.
   60 #Complex1::display_format('cartesian');
   61 
   62 # number format used frequently in strict prefilters
   63 my $number = '([+-]?)(?=\d|\.\d)\d*(\.\d*)?(E([+-]?\d+))?';
   64 
   65 
   66 
   67 
   68 =head3 cplx_cmp
   69 
   70  #  This subroutine compares complex numbers.
   71  #  Available prefilters include:
   72  #  each of these are called by cplx_cmp( answer, mode => '(prefilter name)' )
   73  #  'std'     The standard comparison method for complex numbers. This option it the default
   74  #        and works with any combination of cartesian numbers, polar numbers, and
   75  #        functions. The default display method is cartesian, for all methods, but if
   76  #        the student answer is polar, even in part, then their answer will be displayed
   77  #        that way.
   78  #  'strict_polar'    This is still under developement. The idea is to check to make sure that there
   79  #        only a single term in front of the e and after it... but the method does not
   80  #        check to make sure that the i is in the exponent, nor does it handle cases
   81  #        where the polar has e** coefficients.
   82  #  'strict_num_cartesian'  This prefilter allows only complex numbers of the form "a+bi" where a and b
   83  #        are strictly numbers.
   84  #  'strict_num_polar'  This prefilter allows only complex numbers of the form "ae^(bi)" where a and b
   85  #        are strictly numbers.
   86  #  'strict'    This is a combination of strict_num_cartesian and strict_num_polar, so it
   87  #        allows complex numbers of either the form "a+bi" or "ae^(bi)" where a and b
   88  #        are strictly numbers.
   89 
   90 =cut
   91 
   92 sub cplx_cmp {
   93   my $correctAnswer = shift;
   94   my %cplx_params = @_;
   95 
   96   assign_option_aliases( \%cplx_params,
   97     'reltol'        =>  'relTol',
   98   );
   99   set_default_options(\%cplx_params,
  100     'tolType'   =>  (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
  101       # default mode should be relative, to obtain this tol must not be defined
  102     'tolerance'   =>  $main::numAbsTolDefault,
  103     'relTol'    =>  $main::numRelPercentTolDefault,
  104     'zeroLevel'   =>  $main::numZeroLevelDefault,
  105     'zeroLevelTol'    =>  $main::numZeroLevelTolDefault,
  106     'format'    =>  $main::numFormatDefault,
  107     'debug'     =>  0,
  108     'mode'      =>  'std',
  109     'strings'   =>  undef,
  110   );
  111   my $format      = $cplx_params{'format'};
  112   my $mode      = $cplx_params{'mode'};
  113 
  114   if( $cplx_params{tolType} eq 'relative' ) {
  115     $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
  116   }
  117 
  118   my $formattedCorrectAnswer;
  119   my $correct_num_answer;
  120   my $corrAnswerIsString = 0;
  121 
  122 
  123   if (defined($cplx_params{strings}) && $cplx_params{strings}) {
  124     my $legalString = '';
  125     my @legalStrings = @{$cplx_params{strings}};
  126     $correct_num_answer = $correctAnswer;
  127     $formattedCorrectAnswer = $correctAnswer;
  128     foreach $legalString (@legalStrings) {
  129       if ( uc($correctAnswer) eq uc($legalString) ) {
  130         $corrAnswerIsString = 1;
  131 
  132         last;
  133       }
  134     }     ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
  135   } else {
  136     $correct_num_answer = $correctAnswer;
  137     $formattedCorrectAnswer = prfmt( $correctAnswer, $cplx_params{'format'} );
  138   }
  139   $correct_num_answer = math_constants($correct_num_answer);
  140 
  141   my $PGanswerMessage = '';
  142 
  143 #########################################################################
  144 #  The following lines don't have any effect (other than to take time and produce errors
  145 #  in the error log).  The $correctVal is replaced on the line following the comments,
  146 #  and the error values are never used.  It LOOKS like this was supposed to perform a
  147 #  check on the professor's answer, but that is not occurring.  (There used to be some
  148 #  error checking, but that was removed in version 1.9 and it had been commented out
  149 #  prior to that because it was always producing errors.  This is because $correct_num_answer
  150 #  usually is somethine like "1+4i", which will produce a "missing operation before 'i'"
  151 #  error, and "1-i" wil produce an "amiguous use of '-i' resolved as '-&i'" message.
  152 #  You probably need a call to check_syntax and the other filters that are used on
  153 #  the student answer first. (Unless the item is already a reference to a Complex,
  154 #  in which canse you should just accept it.)
  155 #
  156 # my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
  157 # my $correctVal;
  158 # if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
  159 #     ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
  160 # } else { # case of a string answer
  161 #   $PG_eval_errors = ' ';
  162 #   $correctVal = $correctAnswer;
  163 # }
  164 ########################################################################
  165   my $correctVal = $correct_num_answer;
  166   $correctVal = cplx( $correctVal, 0 ) unless ref($correctVal) =~/^Complex?/ || $corrAnswerIsString == 1;
  167 
  168   #construct the answer evaluator
  169       my $answer_evaluator             = new AnswerEvaluator;
  170     $answer_evaluator->{debug}       = $cplx_params{debug};
  171       $answer_evaluator->ans_hash(
  172                 correct_ans       =>  $correctVal,
  173                 type          =>  "cplx_cmp",
  174                 tolerance       =>  $cplx_params{tolerance},
  175               tolType         =>  'absolute', # $cplx_params{tolType},
  176               original_correct_ans  =>  $formattedCorrectAnswer,
  177                 answerIsString      =>  $corrAnswerIsString,
  178               answer_form       =>  'cartesian',
  179       );
  180       my ($in, $formattedSubmittedAnswer);
  181   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
  182     $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
  183   );
  184   if (defined($cplx_params{strings}) && $cplx_params{strings}) {
  185       $answer_evaluator->install_pre_filter(\&check_strings, %cplx_params);
  186   }
  187 
  188   $answer_evaluator->install_pre_filter(\&check_syntax);
  189   $answer_evaluator->install_pre_filter(\&math_constants);
  190   $answer_evaluator->install_pre_filter(\&cplx_constants);
  191   $answer_evaluator->install_pre_filter(\&check_for_polar);
  192   if ($mode eq 'std') {
  193         # do nothing
  194   } elsif ($mode eq 'strict_polar') {
  195     $answer_evaluator->install_pre_filter(\&is_a_polar);
  196   } elsif ($mode eq 'strict_num_cartesian') {
  197     $answer_evaluator->install_pre_filter(\&is_a_numeric_cartesian);
  198   } elsif ($mode eq 'strict_num_polar') {
  199     $answer_evaluator->install_pre_filter(\&is_a_numeric_polar);
  200   } elsif ($mode eq 'strict') {
  201     $answer_evaluator->install_pre_filter(\&is_a_numeric_complex);
  202   } else {
  203     $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
  204     $formattedSubmittedAnswer = $in;
  205   }
  206 
  207   if ($corrAnswerIsString == 0 ){   # avoiding running compare_cplx when correct answer is a string.
  208     $answer_evaluator->install_evaluator(\&compare_cplx, %cplx_params);
  209   }
  210 
  211 
  212   $answer_evaluator->install_post_filter(\&fix_answers_for_display);
  213   $answer_evaluator->install_post_filter(\&fix_for_polar_display);
  214 
  215   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
  216     return $rh_ans unless $rh_ans->catch_error('EVAL');
  217     $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
  218     $rh_ans->clear_error('EVAL'); }
  219   );
  220   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
  221   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('POLAR'); } );
  222   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('CARTESIAN'); } );
  223   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('COMPLEX'); } );
  224   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
  225   $answer_evaluator;
  226 }
  227 
  228 
  229 =head3 compare_cplx
  230 
  231  #      This is a filter: it accepts and returns an AnswerHash object.
  232  #
  233  #    Usage:  compare_cplx(ans_hash, %options)
  234  #
  235  #      Compares two complex numbers by comparing their real and imaginary parts
  236 
  237 =cut
  238 
  239 sub compare_cplx {
  240   my ($rh_ans, %options) = @_;
  241   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
  242 
  243   if ($PG_eval_errors) {
  244     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  245     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  246      return $rh_ans;
  247   } else {
  248     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
  249   }
  250 
  251   $inVal = cplx($inVal,0) unless ref($inVal) =~/Complex/;
  252   my $permitted_error_Re;
  253   my $permitted_error_Im;
  254   if ($rh_ans->{tolType} eq 'absolute') {
  255     $permitted_error_Re = $rh_ans->{tolerance};
  256     $permitted_error_Im = $rh_ans->{tolerance};
  257   }
  258   elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
  259       $permitted_error_Re = $options{zeroLevelTol};  ## want $tol to be non zero
  260       $permitted_error_Im = $options{zeroLevelTol};  ## want $tol to be non zero
  261   }
  262   else {
  263     $permitted_error_Re =  abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Re);
  264     $permitted_error_Im =  abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Im);
  265 
  266   }
  267 
  268   $rh_ans->{score} = 1 if ( abs( $rh_ans->{correct_ans}->Complex::Re - $inVal->Complex::Re) <=
  269   $permitted_error_Re && abs($rh_ans->{correct_ans}->Complex::Im - $inVal->Complex::Im )<= $permitted_error_Im  );
  270 
  271   $rh_ans;
  272 }
  273 
  274 =head3 multi_cmp
  275 
  276  #
  277  #  Checks a comma separated string of  items against an array of evaluators.
  278  #  For example this is useful for checking all of the complex roots of an equation.
  279  #  Each student answer must be evaluated as correct by a DISTINCT answer evalutor.
  280  #
  281  #  This answer checker will only work reliably if each answer checker corresponds
  282  #  to a distinct correct answer.  For example if one answer checker requires
  283  #  any positive number, and the second requires the answer 1, then 1,2 might
  284  #  be judged incorrect since 1, satisifes the first answer checker, but 2 doesn't
  285  #  satisfy the second.  2,1 would work however. Avoid this type of use!!
  286  #
  287  #  Including backtracking to fit the answers as best possible to each answer evaluator
  288  #  in the best possible way, is beyond the ambitions of this evaluator.
  289 
  290 =cut
  291 
  292 sub multi_cmp {
  293   my $ra_answer_evaluators = shift;  # array of evaluators
  294   my %options = @_;
  295   my @answer_evaluators = @{$ra_answer_evaluators};
  296   my $backup_ans_eval = $answer_evaluators[0];
  297   my $multi_ans_evaluator = new AnswerEvaluator;
  298   $multi_ans_evaluator->{debug}=$options{debug} if defined($options{debug});
  299   $multi_ans_evaluator->install_evaluator( sub {
  300     my $rh_ans = shift;
  301 
  302     my @student_answers = split/\s*,\s*/,$rh_ans->{student_ans};
  303     my @evaluated_ans_hashes = ();
  304     for ( my $j=0; $j<@student_answers; $j++ ) {
  305       # find an answer evaluator which marks this answer correct.
  306       my $student_ans = $student_answers[$j];
  307       my $temp_hash;
  308       for ( my $i=0; $i<@answer_evaluators; $i++ ) {
  309         my $evaluator = $answer_evaluators[$i];
  310         $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
  311         %$temp_hash = %{$evaluator->evaluate($student_ans)};
  312         if (($temp_hash->{score} == 1)) {
  313             # save evaluated answer
  314             push @evaluated_ans_hashes, $temp_hash;
  315           # remove answer evaluator and check the next answer
  316           splice(@answer_evaluators,$i,1);
  317           last;
  318         }
  319       }
  320       # if we exit the loop without finding a correct evaluation:
  321       # make sure every answer is evaluated, even extra answers for which
  322       # there will be no answer evaluators left.
  323       if (not defined($temp_hash) ) { # make sure every answer is evaluated, even extra answers.
  324         my $evaluator = $backup_ans_eval;
  325         $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
  326         %$temp_hash = %{$evaluator->evaluate($student_ans)};
  327         $temp_hash->{score} =0;  # this was an extra answer -- clearly incorrect
  328         $temp_hash->{correct_ans} = "too many answers";
  329       }
  330       # now make sure that even  answers which
  331       # don't never evaluate correctly are still recorded in the list
  332       if ( $temp_hash->{score} <1) {
  333         push @evaluated_ans_hashes, $temp_hash;
  334       }
  335 
  336 
  337     }
  338     # construct the final answer hash
  339     my @saved_evaluated_ans_hashes = @evaluated_ans_hashes;
  340     my $rh_ans_out = shift @evaluated_ans_hashes;
  341     while (@evaluated_ans_hashes) {
  342       my $temp_hash = shift @evaluated_ans_hashes;
  343       $rh_ans_out =$rh_ans_out->AND($temp_hash);
  344     }
  345     $rh_ans_out->{original_student_ans} = $rh_ans->{student_ans};
  346     $rh_ans_out->{student_ans} = $rh_ans->{student_ans};
  347     $rh_ans_out->{score}=0 unless @{$ra_answer_evaluators} == @student_answers; # require the  correct number of answers
  348     $rh_ans_out->{_filter_name} = 'multi_cmp';
  349         $rh_ans_out->{intermediate_response_evaluations} = [@saved_evaluated_ans_hashes];
  350     $rh_ans_out;
  351   });
  352   $multi_ans_evaluator;
  353 }
  354 
  355 sub cplx_constants {
  356   my($in,%options) = @_;
  357   my $rh_ans;
  358   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
  359   if ($process_ans_hash) {
  360     $rh_ans = $in;
  361     $in = $rh_ans->{student_ans};
  362   }
  363   # The code fragment above allows this filter to be used when the input is simply a string
  364   # as well as when the input is an AnswerHash, and options.
  365   $in =~ s/\bi\b/(i)/g;  # try to keep -i being recognized as a file reference
  366                            # and recognized as a function whose output is an imaginary number
  367 
  368   if ($process_ans_hash)   {
  369       $rh_ans->{student_ans}=$in;
  370       return $rh_ans;
  371     } else {
  372     return $in;
  373   }
  374 }
  375 
  376 =head2 Utility functions
  377 
  378  #  for checking the form of a number or of the <student_ans> field in an answer hash
  379 
  380 =cut
  381 
  382 
  383 # Output is text displaying the complex numver in "e to the i theta" form. The
  384 # formats for the argument theta is determined by the option C<theta_format> and the
  385 # format for the modulus is determined by the C<r_format> option.
  386 
  387 #this basically just checks for "e^" which unfortunately will show something like (e^4)*i as a polar, this should be changed
  388 sub check_for_polar{
  389 
  390   my($in,%options) = @_;
  391   my $rh_ans;
  392   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
  393   if ($process_ans_hash) {
  394     $rh_ans = $in;
  395     $in = $rh_ans->{student_ans};
  396   }
  397   # The code fragment above allows this filter to be used when the input is simply a string
  398   # as well as when the input is an AnswerHash, and options.
  399   if( $in =~ /2.71828182845905\*\*/ ){
  400     $rh_ans->{answer_form} = 'polar';
  401   } else {
  402     $rh_ans->{answer_form} = 'cartesian';
  403   }
  404   $rh_ans;
  405 }
  406 
  407 
  408 
  409 
  410 
  411 ## allows only for numbers of the form a+bi and ae^(bi), where a and b are strict numbers
  412 sub is_a_numeric_complex {
  413   my ($num,%options) =  @_;
  414   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  415   my ($rh_ans);
  416   if ($process_ans_hash) {
  417     $rh_ans = $num;
  418     $num = $rh_ans->{student_ans};
  419   }
  420 
  421   my $is_a_number = 0;
  422   return $is_a_number unless defined($num);
  423   $num =~ s/^\s*//; ## remove initial spaces
  424   $num =~ s/\s*$//; ## remove trailing spaces
  425 
  426   if ($num =~
  427 
  428 /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\)|$number)$/){
  429     $is_a_number = 1;
  430   }
  431 
  432   if ($process_ans_hash)   {
  433         if ($is_a_number == 1 ) {
  434           $rh_ans->{student_ans}=$num;
  435           return $rh_ans;
  436         } else {
  437           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric complex, e.g. a+bi
  438       or a*e^(bi)";
  439           $rh_ans->throw_error('COMPLEX', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  440           return $rh_ans;
  441         }
  442   } else {
  443     return $is_a_number;
  444   }
  445 }
  446 
  447 ## allows only for the form a + bi, where a and b are strict numbers
  448 sub is_a_numeric_cartesian {
  449   my ($num,%options) =  @_;
  450   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  451   my ($rh_ans);
  452   if ($process_ans_hash) {
  453     $rh_ans = $num;
  454     $num = $rh_ans->{student_ans};
  455   }
  456 
  457   my $is_a_number = 0;
  458   return $is_a_number unless defined($num);
  459   $num =~ s/^\s*//; ## remove initial spaces
  460   $num =~ s/\s*$//; ## remove trailing spaces
  461 
  462   if ($num =~
  463 
  464 /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|$number)$/){
  465     $is_a_number = 1;
  466   }
  467 
  468   if ($process_ans_hash)   {
  469         if ($is_a_number == 1 ) {
  470           $rh_ans->{student_ans}=$num;
  471           return $rh_ans;
  472         } else {
  473           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric cartesian, e.g. a+bi";
  474           $rh_ans->throw_error('CARTESIAN', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  475           return $rh_ans;
  476         }
  477   } else {
  478     return $is_a_number;
  479   }
  480 }
  481 
  482 ## allows only for the form ae^(bi), where a and b are strict numbers
  483 sub is_a_numeric_polar {
  484   my ($num,%options) =  @_;
  485   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  486   my ($rh_ans);
  487   if ($process_ans_hash) {
  488     $rh_ans = $num;
  489     $num = $rh_ans->{student_ans};
  490   }
  491 
  492   my $is_a_number = 0;
  493   return $is_a_number unless defined($num);
  494   $num =~ s/^\s*//; ## remove initial spaces
  495   $num =~ s/\s*$//; ## remove trailing spaces
  496   if ($num =~
  497   /^($number|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\))$/){
  498     $is_a_number = 1;
  499   }
  500 
  501   if ($process_ans_hash)   {
  502         if ($is_a_number == 1 ) {
  503           $rh_ans->{student_ans}=$num;
  504           return $rh_ans;
  505         } else {
  506           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric polar, e.g. a*e^(bi)";
  507           $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  508           return $rh_ans;
  509         }
  510   } else {
  511     return $is_a_number;
  512   }
  513 }
  514 
  515 
  516 #this subroutine mearly captures what is before and after the "e**" it does not verify that the "i" is there, or in the
  517 #exponent this must eventually be addresed
  518 sub is_a_polar {
  519   my ($num,%options) =  @_;
  520   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  521   my ($rh_ans);
  522   if ($process_ans_hash) {
  523     $rh_ans = $num;
  524     $num = $rh_ans->{student_ans};
  525   }
  526 
  527   my $is_a_number = 0;
  528   return $is_a_number unless defined($num);
  529   $num =~ s/^\s*//; ## remove initial spaces
  530   $num =~ s/\s*$//; ## remove trailing spaces
  531   $num =~ /^(.*)\*2.71828182845905\*\*(.*)/;
  532   #warn "rho: ", $1;
  533   #warn "theta: ", $2;
  534   if( defined( $1 ) ){
  535     if( &single_term( $1 ) && &single_term( $2 ) )
  536     {
  537       $is_a_number = 1;
  538     }
  539   }
  540   if ($process_ans_hash)   {
  541         if ($is_a_number == 1 ) {
  542           $rh_ans->{student_ans}=$num;
  543           return $rh_ans;
  544         } else {
  545           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a polar, e.g. a*e^(bi)";
  546           $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  547           return $rh_ans;
  548         }
  549   } else {
  550     return $is_a_number;
  551   }
  552 }
  553 
  554 =head4 single_term()
  555 
  556  #  This subroutine takes in a string, which is a mathematical expresion, and determines whether or not
  557  #  it is a single term. This is accoplished using a stack. Open parenthesis pluses and minuses are all
  558  #  added onto the stack, and when a closed parenthesis is reached, the stack is popped untill the open
  559  #  parenthesis is found. If the original was a single term, the stack should be empty after
  560  #  evaluation. If there is anything left ( + or - ) then false is returned.
  561  #  Of course, the unary operator "-" must be handled... if it is a unary operator, and not a regular -
  562  #  the only place it could occur unambiguously without being surrounded by parenthesis, is the very
  563  #  first position. So that case is checked before the loop begins.
  564 
  565 =cut
  566 
  567 sub single_term{
  568   my $term = shift;
  569   my @stack;
  570   $term = reverse $term;
  571   if( length $term >= 1 )
  572   {
  573     my $temp = chop $term;
  574     if( $temp ne "-" ){ $term .= $temp; }
  575   }
  576   while( length $term >= 1 ){
  577     my $character = chop $term;
  578     if( $character eq "+" || $character eq "-" || $character eq "(" ){
  579       push @stack, $character;
  580     }elsif( $character eq ")" ){
  581       while( pop @stack ne "(" ){}
  582     }
  583 
  584   }
  585   if( scalar @stack == 0 ){ return 1;}else{ return 0;}
  586 }
  587 
  588 # changes default to display as a polar
  589 sub fix_for_polar_display{
  590   my ($rh_ans, %options) = @_;
  591   if( ref( $rh_ans->{student_ans} ) =~ /Complex/ && $rh_ans->{answer_form} eq 'polar' ){
  592     $rh_ans->{student_ans}->display_format( 'polar');
  593     ## these lines of code have the polar displayed as re^(theta) instead of [rho,theta]
  594     $rh_ans->{student_ans} =~ s/,/*e^\(/;
  595     $rh_ans->{student_ans} =~ s/\[//;
  596     $rh_ans->{student_ans} =~ s/\]/i\)/;
  597     }
  598   $rh_ans;
  599 }
  600 
  601 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  602 
  603 # sub cplx_cmp2 {
  604   ####.............###########
  605 # }
  606 
  607 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  608 
  609 # sub cplx_cmp_mult {
  610   ####.............###########
  611 # }
  612 
  613 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  614 
  615 # sub answer_mult{
  616   ####.............###########
  617 # }
  618 #
  619 # sub multi_cmp_old{
  620   ####.............###########
  621 # }
  622 
  623 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  624 
  625 # sub mult_cmp{
  626   ####.............###########
  627 # }
  628 
  629 
  630 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9