[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 6220 - (download) (as text) (annotate)
Thu Apr 1 00:24:26 2010 UTC (9 years, 10 months ago) by dpvc
File size: 22718 byte(s)
Back out of accidental commit of complex macros

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9