[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 6219 - (download) (as text) (annotate)
Thu Apr 1 00:21:45 2010 UTC (9 years, 10 months ago) by dpvc
File size: 27041 byte(s)
Provide a limited context in which rational functions can be specified

    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 my %cplx_context = (
   94   'std' => 'Complex',
   95   'strict' => 'LimitedComplex-strict',
   96   'strict_polar' => 'LimitedComplex-polar',
   97   'strict_cartesian' => 'LimitedComplex-cartesian',
   98   'strict_num_polar' => 'LimitedComplex-polar-strict',
   99   'strict_num_cartesian' => 'LimitedComplex-cartesian-strict',
  100 );
  101 
  102 sub cplx_cmp {
  103   return original_cplx_cmp(@_) if $main::useOldAnswerMacros;
  104 
  105   my $correctAnswer = shift;
  106   my %cplx_params = @_;
  107 
  108   #
  109   #  Get default options
  110   #
  111   assign_option_aliases( \%cplx_params,
  112     'reltol'        =>  'relTol',
  113   );
  114   set_default_options(\%cplx_params,
  115     'tolType'   =>  (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
  116       # default mode should be relative, to obtain this tol must not be defined
  117     'tolerance'   =>  $main::numAbsTolDefault,
  118     'relTol'    =>  $main::numRelPercentTolDefault,
  119     'zeroLevel'   =>  $main::numZeroLevelDefault,
  120     'zeroLevelTol'    =>  $main::numZeroLevelTolDefault,
  121     'format'    =>  $main::numFormatDefault,
  122     'debug'     =>  0,
  123     'mode'      =>  'std',
  124     'strings'   =>  undef,
  125   );
  126   my $format      = $cplx_params{'format'};
  127   my $mode      = $cplx_params{'mode'};
  128 
  129   if( $cplx_params{tolType} eq 'relative' ) {
  130     $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
  131   }
  132 
  133   my $context = $cplx_context{$mode};
  134   unless ($context) {$context = "Complex"; warn "Unknown mode '$mode'"}
  135   $context = $Parser::Context::Default::context{$context}->copy;
  136 
  137   #
  138   #  Set the format for the context
  139   #
  140   $context->{format}{number} = $cplx_params{'format'} if $cplx_params{'format'};
  141 
  142   #
  143   #  Add the strings to the context
  144   #
  145   if ($cplx_params{strings}) {
  146     foreach my $string (@{$cplx_params{strings}}) {
  147       my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): ();
  148       $context->strings->add(uc($string) => {%tex})
  149         unless $context->strings->get(uc($string));
  150     }
  151   }
  152 
  153   #
  154   #  Set the tolerances
  155   #
  156   if ($cplx_params{tolType} eq 'absolute') {
  157     $context->flags->set(
  158       tolerance => $cplx_params{tolerance},
  159       tolType => 'absolute',
  160     );
  161   } else {
  162     $context->flags->set(
  163       tolerance => .01*$cplx_params{tolerance},
  164       tolType => 'relative',
  165     );
  166   }
  167   $context->flags->set(
  168     zeroLevel => $cplx_params{zeroLevel},
  169     zeroLevelTol => $cplx_params{zeroLevelTol},
  170   );
  171 
  172   #
  173   #  Get the proper Parser object for the professor's answer
  174   #  using the initialized context
  175   #
  176   my $oldContext = Parser::Context->current(\%main::context,$context); my $z;
  177   if (ref($correctAnswer) eq 'Complex') {
  178     $z = Value::Complex->new($correctAnswer->Re,$correctAnswer->Im);
  179   } else {
  180     $z = Value::Formula->new($correctAnswer);
  181     die "The professor's answer can't be a formula" unless $z->isConstant;
  182     $z = $z->eval; $z = new Value::Complex($z) unless Value::class($z) eq 'String';
  183   }
  184   $z->{correct_ans} = $correctAnswer;
  185 
  186   #
  187   #  Get the answer checker from the parser object
  188   #
  189   my $cmp = $z->cmp;
  190   $cmp->install_pre_filter(sub {
  191     my $rh_ans = shift;
  192     $rh_ans->{original_student_ans} = $rh_ans->{student_ans};
  193     $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans};
  194     return $rh_ans;
  195   });
  196   $cmp->install_post_filter(sub {
  197     my $rh_ans = shift; my $z = $rh_ans->{student_value};
  198     #
  199     #  Stringify student answer (use polar form if student did)
  200     #
  201     if (ref($z) && $z->isNumber) {
  202       $z = Value::Complex->new($z); # promote real to complex
  203       if ($rh_ans->{original_student_ans} =~ m/(^|[^a-zA-Z])e\s*(\^|\*\*)/) {
  204         my ($a,$b) = ($z->mod,$z->arg);
  205         unless ($context->flag('strict_numeric')) {
  206     my $rt = (new Complex($z->Re->value,$z->Im->value))->stringify_polar;
  207     ($a,$b) = ($rt =~ m/\[(.*),(.*)\]/);
  208         }
  209         $a = Value::Real->new($a)->string;
  210         $b = Value::Real->new($b)->string if Value::matchNumber($b);
  211         if ($b eq '0') {
  212     $rh_ans->{student_ans} = $a;
  213         } else {
  214     if ($a eq '1') {$a = ''} elsif ($a eq '-1') {$a = '-'} else {$a .= '*'}
  215     if ($b eq '1') {$b = 'i'} elsif ($b eq '-1') {$b = '(-i)'} else {$b = "($b i)"}
  216     $rh_ans->{student_ans} = $a.'e^'.$b;
  217         }
  218       } else {
  219         $rh_ans->{student_ans} = $rh_ans->{student_value}->string;
  220       }
  221     }
  222     return $rh_ans;
  223   });
  224   $cmp->{debug} = $cplx_params{debug};
  225   Parser::Context->current(\%main::context,$oldContext);
  226 
  227   return $cmp;
  228 }
  229 
  230 #
  231 #  The original version, for backward compatibility
  232 #  (can be removed when the Parser-based version is more fully tested.)
  233 #
  234 sub original_cplx_cmp {
  235   my $correctAnswer = shift;
  236   my %cplx_params = @_;
  237 
  238   assign_option_aliases( \%cplx_params,
  239     'reltol'        =>  'relTol',
  240   );
  241   set_default_options(\%cplx_params,
  242     'tolType'   =>  (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
  243       # default mode should be relative, to obtain this tol must not be defined
  244     'tolerance'   =>  $main::numAbsTolDefault,
  245     'relTol'    =>  $main::numRelPercentTolDefault,
  246     'zeroLevel'   =>  $main::numZeroLevelDefault,
  247     'zeroLevelTol'    =>  $main::numZeroLevelTolDefault,
  248     'format'    =>  $main::numFormatDefault,
  249     'debug'     =>  0,
  250     'mode'      =>  'std',
  251     'strings'   =>  undef,
  252   );
  253   my $format      = $cplx_params{'format'};
  254   my $mode      = $cplx_params{'mode'};
  255 
  256   if( $cplx_params{tolType} eq 'relative' ) {
  257     $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
  258   }
  259 
  260   my $formattedCorrectAnswer;
  261   my $correct_num_answer;
  262   my $corrAnswerIsString = 0;
  263 
  264 
  265   if (defined($cplx_params{strings}) && $cplx_params{strings}) {
  266     my $legalString = '';
  267     my @legalStrings = @{$cplx_params{strings}};
  268     $correct_num_answer = $correctAnswer;
  269     $formattedCorrectAnswer = $correctAnswer;
  270     foreach $legalString (@legalStrings) {
  271       if ( uc($correctAnswer) eq uc($legalString) ) {
  272         $corrAnswerIsString = 1;
  273 
  274         last;
  275       }
  276     }     ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
  277   } else {
  278     $correct_num_answer = $correctAnswer;
  279     $formattedCorrectAnswer = prfmt( $correctAnswer, $cplx_params{'format'} );
  280   }
  281   $correct_num_answer = math_constants($correct_num_answer);
  282 
  283   my $PGanswerMessage = '';
  284 
  285 #########################################################################
  286 #  The following lines don't have any effect (other than to take time and produce errors
  287 #  in the error log).  The $correctVal is replaced on the line following the comments,
  288 #  and the error values are never used.  It LOOKS like this was supposed to perform a
  289 #  check on the professor's answer, but that is not occurring.  (There used to be some
  290 #  error checking, but that was removed in version 1.9 and it had been commented out
  291 #  prior to that because it was always producing errors.  This is because $correct_num_answer
  292 #  usually is somethine like "1+4i", which will produce a "missing operation before 'i'"
  293 #  error, and "1-i" wil produce an "amiguous use of '-i' resolved as '-&i'" message.
  294 #  You probably need a call to check_syntax and the other filters that are used on
  295 #  the student answer first. (Unless the item is already a reference to a Complex,
  296 #  in which canse you should just accept it.)
  297 #
  298 # my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
  299 # my $correctVal;
  300 # if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
  301 #     ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
  302 # } else { # case of a string answer
  303 #   $PG_eval_errors = ' ';
  304 #   $correctVal = $correctAnswer;
  305 # }
  306 ########################################################################
  307   my $correctVal = $correct_num_answer;
  308   $correctVal = cplx( $correctVal, 0 ) unless ref($correctVal) =~/^Complex?/ || $corrAnswerIsString == 1;
  309 
  310   #construct the answer evaluator
  311       my $answer_evaluator             = new AnswerEvaluator;
  312     $answer_evaluator->{debug}       = $cplx_params{debug};
  313       $answer_evaluator->ans_hash(
  314                 correct_ans       =>  $correctVal,
  315                 type          =>  "cplx_cmp",
  316                 tolerance       =>  $cplx_params{tolerance},
  317               tolType         =>  'absolute', # $cplx_params{tolType},
  318               original_correct_ans  =>  $formattedCorrectAnswer,
  319                 answerIsString      =>  $corrAnswerIsString,
  320               answer_form       =>  'cartesian',
  321       );
  322       my ($in, $formattedSubmittedAnswer);
  323   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
  324     $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
  325   );
  326   if (defined($cplx_params{strings}) && $cplx_params{strings}) {
  327       $answer_evaluator->install_pre_filter(\&check_strings, %cplx_params);
  328   }
  329 
  330   $answer_evaluator->install_pre_filter(\&check_syntax);
  331   $answer_evaluator->install_pre_filter(\&math_constants);
  332   $answer_evaluator->install_pre_filter(\&cplx_constants);
  333   $answer_evaluator->install_pre_filter(\&check_for_polar);
  334   if ($mode eq 'std') {
  335         # do nothing
  336   } elsif ($mode eq 'strict_polar') {
  337     $answer_evaluator->install_pre_filter(\&is_a_polar);
  338   } elsif ($mode eq 'strict_num_cartesian') {
  339     $answer_evaluator->install_pre_filter(\&is_a_numeric_cartesian);
  340   } elsif ($mode eq 'strict_num_polar') {
  341     $answer_evaluator->install_pre_filter(\&is_a_numeric_polar);
  342   } elsif ($mode eq 'strict') {
  343     $answer_evaluator->install_pre_filter(\&is_a_numeric_complex);
  344   } else {
  345     $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
  346     $formattedSubmittedAnswer = $in;
  347   }
  348 
  349   if ($corrAnswerIsString == 0 ){   # avoiding running compare_cplx when correct answer is a string.
  350     $answer_evaluator->install_evaluator(\&compare_cplx, %cplx_params);
  351   }
  352 
  353 
  354   $answer_evaluator->install_post_filter(\&fix_answers_for_display);
  355   $answer_evaluator->install_post_filter(\&fix_for_polar_display);
  356 
  357   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
  358     return $rh_ans unless $rh_ans->catch_error('EVAL');
  359     $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
  360     $rh_ans->clear_error('EVAL'); }
  361   );
  362   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
  363   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('POLAR'); } );
  364   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('CARTESIAN'); } );
  365   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('COMPLEX'); } );
  366   $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
  367   $answer_evaluator;
  368 }
  369 
  370 
  371 =head3 compare_cplx
  372 
  373  #      This is a filter: it accepts and returns an AnswerHash object.
  374  #
  375  #    Usage:  compare_cplx(ans_hash, %options)
  376  #
  377  #      Compares two complex numbers by comparing their real and imaginary parts
  378 
  379 =cut
  380 
  381 sub compare_cplx {
  382   my ($rh_ans, %options) = @_;
  383   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
  384 
  385   if ($PG_eval_errors) {
  386     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  387     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  388      return $rh_ans;
  389   } else {
  390     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
  391   }
  392 
  393   $inVal = cplx($inVal,0) unless ref($inVal) =~/Complex/;
  394   my $permitted_error_Re;
  395   my $permitted_error_Im;
  396   if ($rh_ans->{tolType} eq 'absolute') {
  397     $permitted_error_Re = $rh_ans->{tolerance};
  398     $permitted_error_Im = $rh_ans->{tolerance};
  399   }
  400   elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
  401       $permitted_error_Re = $options{zeroLevelTol};  ## want $tol to be non zero
  402       $permitted_error_Im = $options{zeroLevelTol};  ## want $tol to be non zero
  403   }
  404   else {
  405     $permitted_error_Re =  abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Re);
  406     $permitted_error_Im =  abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Im);
  407 
  408   }
  409 
  410   $rh_ans->{score} = 1 if ( abs( $rh_ans->{correct_ans}->Complex::Re - $inVal->Complex::Re) <=
  411   $permitted_error_Re && abs($rh_ans->{correct_ans}->Complex::Im - $inVal->Complex::Im )<= $permitted_error_Im  );
  412 
  413   $rh_ans;
  414 }
  415 
  416 =head3 multi_cmp
  417 
  418  #
  419  #  Checks a comma separated string of  items against an array of evaluators.
  420  #  For example this is useful for checking all of the complex roots of an equation.
  421  #  Each student answer must be evaluated as correct by a DISTINCT answer evalutor.
  422  #
  423  #  This answer checker will only work reliably if each answer checker corresponds
  424  #  to a distinct correct answer.  For example if one answer checker requires
  425  #  any positive number, and the second requires the answer 1, then 1,2 might
  426  #  be judged incorrect since 1, satisifes the first answer checker, but 2 doesn't
  427  #  satisfy the second.  2,1 would work however. Avoid this type of use!!
  428  #
  429  #  Including backtracking to fit the answers as best possible to each answer evaluator
  430  #  in the best possible way, is beyond the ambitions of this evaluator.
  431 
  432 =cut
  433 
  434 sub multi_cmp {
  435   my $ra_answer_evaluators = shift;  # array of evaluators
  436   my %options = @_;
  437   my @answer_evaluators = @{$ra_answer_evaluators};
  438   my $backup_ans_eval = $answer_evaluators[0];
  439   my $multi_ans_evaluator = new AnswerEvaluator;
  440   $multi_ans_evaluator->{debug}=$options{debug} if defined($options{debug});
  441   $multi_ans_evaluator->install_evaluator( sub {
  442     my $rh_ans = shift;
  443 
  444     my @student_answers = split/\s*,\s*/,$rh_ans->{student_ans};
  445     my @evaluated_ans_hashes = ();
  446     for ( my $j=0; $j<@student_answers; $j++ ) {
  447       # find an answer evaluator which marks this answer correct.
  448       my $student_ans = $student_answers[$j];
  449       my $temp_hash;
  450       for ( my $i=0; $i<@answer_evaluators; $i++ ) {
  451         my $evaluator = $answer_evaluators[$i];
  452         $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
  453         %$temp_hash = %{$evaluator->evaluate($student_ans)};
  454         if (($temp_hash->{score} == 1)) {
  455             # save evaluated answer
  456             push @evaluated_ans_hashes, $temp_hash;
  457           # remove answer evaluator and check the next answer
  458           splice(@answer_evaluators,$i,1);
  459           last;
  460         }
  461       }
  462       # if we exit the loop without finding a correct evaluation:
  463       # make sure every answer is evaluated, even extra answers for which
  464       # there will be no answer evaluators left.
  465       if (not defined($temp_hash) ) { # make sure every answer is evaluated, even extra answers.
  466         my $evaluator = $backup_ans_eval;
  467         $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
  468         %$temp_hash = %{$evaluator->evaluate($student_ans)};
  469         $temp_hash->{score} =0;  # this was an extra answer -- clearly incorrect
  470         $temp_hash->{correct_ans} = "too many answers";
  471       }
  472       # now make sure that even  answers which
  473       # don't never evaluate correctly are still recorded in the list
  474       if ( $temp_hash->{score} <1) {
  475         push @evaluated_ans_hashes, $temp_hash;
  476       }
  477 
  478 
  479     }
  480     # construct the final answer hash
  481     my @saved_evaluated_ans_hashes = @evaluated_ans_hashes;
  482     my $rh_ans_out = shift @evaluated_ans_hashes;
  483     while (@evaluated_ans_hashes) {
  484       my $temp_hash = shift @evaluated_ans_hashes;
  485       $rh_ans_out =$rh_ans_out->AND($temp_hash);
  486     }
  487     $rh_ans_out->{original_student_ans} = $rh_ans->{student_ans};
  488     $rh_ans_out->{student_ans} = $rh_ans->{student_ans};
  489     $rh_ans_out->{score}=0 unless @{$ra_answer_evaluators} == @student_answers; # require the  correct number of answers
  490     $rh_ans_out->{_filter_name} = 'multi_cmp';
  491         $rh_ans_out->{intermediate_response_evaluations} = [@saved_evaluated_ans_hashes];
  492     $rh_ans_out;
  493   });
  494   $multi_ans_evaluator;
  495 }
  496 
  497 sub cplx_constants {
  498   my($in,%options) = @_;
  499   my $rh_ans;
  500   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
  501   if ($process_ans_hash) {
  502     $rh_ans = $in;
  503     $in = $rh_ans->{student_ans};
  504   }
  505   # The code fragment above allows this filter to be used when the input is simply a string
  506   # as well as when the input is an AnswerHash, and options.
  507   $in =~ s/\bi\b/(i)/g;  # try to keep -i being recognized as a file reference
  508                            # and recognized as a function whose output is an imaginary number
  509 
  510   if ($process_ans_hash)   {
  511       $rh_ans->{student_ans}=$in;
  512       return $rh_ans;
  513     } else {
  514     return $in;
  515   }
  516 }
  517 
  518 =head2 Utility functions
  519 
  520  #  for checking the form of a number or of the <student_ans> field in an answer hash
  521 
  522 =cut
  523 
  524 
  525 # Output is text displaying the complex numver in "e to the i theta" form. The
  526 # formats for the argument theta is determined by the option C<theta_format> and the
  527 # format for the modulus is determined by the C<r_format> option.
  528 
  529 #this basically just checks for "e^" which unfortunately will show something like (e^4)*i as a polar, this should be changed
  530 sub check_for_polar{
  531 
  532   my($in,%options) = @_;
  533   my $rh_ans;
  534   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
  535   if ($process_ans_hash) {
  536     $rh_ans = $in;
  537     $in = $rh_ans->{student_ans};
  538   }
  539   # The code fragment above allows this filter to be used when the input is simply a string
  540   # as well as when the input is an AnswerHash, and options.
  541   if( $in =~ /2.71828182845905\*\*/ ){
  542     $rh_ans->{answer_form} = 'polar';
  543   } else {
  544     $rh_ans->{answer_form} = 'cartesian';
  545   }
  546   $rh_ans;
  547 }
  548 
  549 
  550 
  551 
  552 
  553 ## allows only for numbers of the form a+bi and ae^(bi), where a and b are strict numbers
  554 sub is_a_numeric_complex {
  555   my ($num,%options) =  @_;
  556   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  557   my ($rh_ans);
  558   if ($process_ans_hash) {
  559     $rh_ans = $num;
  560     $num = $rh_ans->{student_ans};
  561   }
  562 
  563   my $is_a_number = 0;
  564   return $is_a_number unless defined($num);
  565   $num =~ s/^\s*//; ## remove initial spaces
  566   $num =~ s/\s*$//; ## remove trailing spaces
  567 
  568   if ($num =~
  569 
  570 /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\)|$number)$/){
  571     $is_a_number = 1;
  572   }
  573 
  574   if ($process_ans_hash)   {
  575         if ($is_a_number == 1 ) {
  576           $rh_ans->{student_ans}=$num;
  577           return $rh_ans;
  578         } else {
  579           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric complex, e.g. a+bi
  580       or a*e^(bi)";
  581           $rh_ans->throw_error('COMPLEX', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  582           return $rh_ans;
  583         }
  584   } else {
  585     return $is_a_number;
  586   }
  587 }
  588 
  589 ## allows only for the form a + bi, where a and b are strict numbers
  590 sub is_a_numeric_cartesian {
  591   my ($num,%options) =  @_;
  592   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  593   my ($rh_ans);
  594   if ($process_ans_hash) {
  595     $rh_ans = $num;
  596     $num = $rh_ans->{student_ans};
  597   }
  598 
  599   my $is_a_number = 0;
  600   return $is_a_number unless defined($num);
  601   $num =~ s/^\s*//; ## remove initial spaces
  602   $num =~ s/\s*$//; ## remove trailing spaces
  603 
  604   if ($num =~
  605 
  606 /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|$number)$/){
  607     $is_a_number = 1;
  608   }
  609 
  610   if ($process_ans_hash)   {
  611         if ($is_a_number == 1 ) {
  612           $rh_ans->{student_ans}=$num;
  613           return $rh_ans;
  614         } else {
  615           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric cartesian, e.g. a+bi";
  616           $rh_ans->throw_error('CARTESIAN', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  617           return $rh_ans;
  618         }
  619   } else {
  620     return $is_a_number;
  621   }
  622 }
  623 
  624 ## allows only for the form ae^(bi), where a and b are strict numbers
  625 sub is_a_numeric_polar {
  626   my ($num,%options) =  @_;
  627   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  628   my ($rh_ans);
  629   if ($process_ans_hash) {
  630     $rh_ans = $num;
  631     $num = $rh_ans->{student_ans};
  632   }
  633 
  634   my $is_a_number = 0;
  635   return $is_a_number unless defined($num);
  636   $num =~ s/^\s*//; ## remove initial spaces
  637   $num =~ s/\s*$//; ## remove trailing spaces
  638   if ($num =~
  639   /^($number|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\))$/){
  640     $is_a_number = 1;
  641   }
  642 
  643   if ($process_ans_hash)   {
  644         if ($is_a_number == 1 ) {
  645           $rh_ans->{student_ans}=$num;
  646           return $rh_ans;
  647         } else {
  648           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a numeric polar, e.g. a*e^(bi)";
  649           $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  650           return $rh_ans;
  651         }
  652   } else {
  653     return $is_a_number;
  654   }
  655 }
  656 
  657 
  658 #this subroutine mearly captures what is before and after the "e**" it does not verify that the "i" is there, or in the
  659 #exponent this must eventually be addresed
  660 sub is_a_polar {
  661   my ($num,%options) =  @_;
  662   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  663   my ($rh_ans);
  664   if ($process_ans_hash) {
  665     $rh_ans = $num;
  666     $num = $rh_ans->{student_ans};
  667   }
  668 
  669   my $is_a_number = 0;
  670   return $is_a_number unless defined($num);
  671   $num =~ s/^\s*//; ## remove initial spaces
  672   $num =~ s/\s*$//; ## remove trailing spaces
  673   $num =~ /^(.*)\*2.71828182845905\*\*(.*)/;
  674   #warn "rho: ", $1;
  675   #warn "theta: ", $2;
  676   if( defined( $1 ) ){
  677     if( &single_term( $1 ) && &single_term( $2 ) )
  678     {
  679       $is_a_number = 1;
  680     }
  681   }
  682   if ($process_ans_hash)   {
  683         if ($is_a_number == 1 ) {
  684           $rh_ans->{student_ans}=$num;
  685           return $rh_ans;
  686         } else {
  687           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a polar, e.g. a*e^(bi)";
  688           $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
  689           return $rh_ans;
  690         }
  691   } else {
  692     return $is_a_number;
  693   }
  694 }
  695 
  696 =head4 single_term()
  697 
  698  #  This subroutine takes in a string, which is a mathematical expresion, and determines whether or not
  699  #  it is a single term. This is accoplished using a stack. Open parenthesis pluses and minuses are all
  700  #  added onto the stack, and when a closed parenthesis is reached, the stack is popped untill the open
  701  #  parenthesis is found. If the original was a single term, the stack should be empty after
  702  #  evaluation. If there is anything left ( + or - ) then false is returned.
  703  #  Of course, the unary operator "-" must be handled... if it is a unary operator, and not a regular -
  704  #  the only place it could occur unambiguously without being surrounded by parenthesis, is the very
  705  #  first position. So that case is checked before the loop begins.
  706 
  707 =cut
  708 
  709 sub single_term{
  710   my $term = shift;
  711   my @stack;
  712   $term = reverse $term;
  713   if( length $term >= 1 )
  714   {
  715     my $temp = chop $term;
  716     if( $temp ne "-" ){ $term .= $temp; }
  717   }
  718   while( length $term >= 1 ){
  719     my $character = chop $term;
  720     if( $character eq "+" || $character eq "-" || $character eq "(" ){
  721       push @stack, $character;
  722     }elsif( $character eq ")" ){
  723       while( pop @stack ne "(" ){}
  724     }
  725 
  726   }
  727   if( scalar @stack == 0 ){ return 1;}else{ return 0;}
  728 }
  729 
  730 # changes default to display as a polar
  731 sub fix_for_polar_display{
  732   my ($rh_ans, %options) = @_;
  733   if( ref( $rh_ans->{student_ans} ) =~ /Complex/ && $rh_ans->{answer_form} eq 'polar' ){
  734     $rh_ans->{student_ans}->display_format( 'polar');
  735     ## these lines of code have the polar displayed as re^(theta) instead of [rho,theta]
  736     $rh_ans->{student_ans} =~ s/,/*e^\(/;
  737     $rh_ans->{student_ans} =~ s/\[//;
  738     $rh_ans->{student_ans} =~ s/\]/i\)/;
  739     }
  740   $rh_ans;
  741 }
  742 
  743 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  744 
  745 # sub cplx_cmp2 {
  746   ####.............###########
  747 # }
  748 
  749 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  750 
  751 # sub cplx_cmp_mult {
  752   ####.............###########
  753 # }
  754 
  755 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  756 
  757 # sub answer_mult{
  758   ####.............###########
  759 # }
  760 #
  761 # sub multi_cmp_old{
  762   ####.............###########
  763 # }
  764 
  765 # this does not seem to be in use, so I'm commenting it out.  Mike Gage 6/27/05
  766 
  767 # sub mult_cmp{
  768   ####.............###########
  769 # }
  770 
  771 
  772 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9