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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4997 - (view) (download) (as text)

1 : sh002i 1050 # 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 : lr003k 1102
27 : sh002i 1050 }
28 :    
29 :    
30 :    
31 :     sub _PGcomplexmacros_init {
32 :     }
33 :     # export functions from Complex1.
34 :    
35 :     foreach my $f (@Complex1::EXPORT) {
36 : lr003k 1102 # #PG_restricted_eval("\*$f = \*Complex1::$f"); # this is too clever --
37 : sh002i 1050 # the original subroutines are destroyed
38 : dpvc 3601 # 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 : sh002i 1050
43 : dpvc 3601 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 : sh002i 1050 PG_restricted_eval($string);
50 : dpvc 3601 }
51 :    
52 : sh002i 1050 }
53 :    
54 : gage 1072
55 : lr003k 1102 # You need to add
56 : sh002i 1050 # 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 : gage 4762 =head3 cplx_cmp
69 : gage 4997
70 : gage 4762 # 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 : sh002i 1050
90 :     =cut
91 :    
92 :     sub cplx_cmp {
93 :     my $correctAnswer = shift;
94 :     my %cplx_params = @_;
95 : lr003k 1102
96 : sh002i 1050 assign_option_aliases( \%cplx_params,
97 : gage 3319 '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 : lr003k 1102
114 : sh002i 1050 if( $cplx_params{tolType} eq 'relative' ) {
115 : apizer 2986 $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
116 : sh002i 1050 }
117 : lr003k 1102
118 : sh002i 1050 my $formattedCorrectAnswer;
119 :     my $correct_num_answer;
120 :     my $corrAnswerIsString = 0;
121 : lr003k 1102
122 : sh002i 1050
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 : lr003k 1102
132 : sh002i 1050 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 : lr003k 1102
141 : sh002i 1050 my $PGanswerMessage = '';
142 : dpvc 3601
143 : gage 4762 #########################################################################
144 : dpvc 3601 # 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 : gage 4762 # my $correctVal;
158 : dpvc 3601 # 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 : gage 4762 # }
164 :     ########################################################################
165 :     my $correctVal = $correct_num_answer;
166 : lr003k 1102 $correctVal = cplx( $correctVal, 0 ) unless ref($correctVal) =~/^Complex?/ || $corrAnswerIsString == 1;
167 :    
168 :     #construct the answer evaluator
169 : gage 3319 my $answer_evaluator = new AnswerEvaluator;
170 :     $answer_evaluator->{debug} = $cplx_params{debug};
171 : lr003k 1102 $answer_evaluator->ans_hash(
172 : sh002i 1050 correct_ans => $correctVal,
173 : gage 3319 type => "cplx_cmp",
174 :     tolerance => $cplx_params{tolerance},
175 :     tolType => 'absolute', # $cplx_params{tolType},
176 :     original_correct_ans => $formattedCorrectAnswer,
177 : sh002i 1050 answerIsString => $corrAnswerIsString,
178 : gage 3319 answer_form => 'cartesian',
179 : sh002i 1050 );
180 :     my ($in, $formattedSubmittedAnswer);
181 : lr003k 1102 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
182 : sh002i 1050 $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 : lr003k 1102 # do nothing
194 : sh002i 1050 } 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 : lr003k 1102 } 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 : sh002i 1050
207 : lr003k 1102 if ($corrAnswerIsString == 0 ){ # avoiding running compare_cplx when correct answer is a string.
208 : sh002i 1050 $answer_evaluator->install_evaluator(\&compare_cplx, %cplx_params);
209 :     }
210 : lr003k 1102
211 : sh002i 1050
212 :     $answer_evaluator->install_post_filter(\&fix_answers_for_display);
213 :     $answer_evaluator->install_post_filter(\&fix_for_polar_display);
214 : lr003k 1102
215 : gage 4762 $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 : sh002i 1050 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
225 : gage 4762 $answer_evaluator;
226 : sh002i 1050 }
227 :    
228 :    
229 : gage 4762 =head3 compare_cplx
230 : sh002i 1050
231 : gage 4762 # 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 : lr003k 1102 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 : jj 2958 return $rh_ans;
247 : lr003k 1102 } 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 : apizer 1080
274 : gage 4762 =head3 multi_cmp
275 : sh002i 1050
276 : gage 4762 #
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 : gage 3319
290 :     =cut
291 : sh002i 1050
292 : gage 3319 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 : gage 4761 $multi_ans_evaluator->{debug}=$options{debug} if defined($options{debug});
299 : gage 3319 $multi_ans_evaluator->install_evaluator( sub {
300 :     my $rh_ans = shift;
301 : gage 4761
302 : gage 3319 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 : sh002i 1050 }
330 : gage 3319 # 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 : sh002i 1050 }
335 : apizer 1080
336 : gage 3319
337 : lr003k 1102 }
338 : gage 3319 # construct the final answer hash
339 : gage 4761 my @saved_evaluated_ans_hashes = @evaluated_ans_hashes;
340 : gage 3319 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 : gage 4761 $rh_ans_out->{original_student_ans} = $rh_ans->{student_ans};
346 : gage 3319 $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 : gage 4761 $rh_ans_out->{_filter_name} = 'multi_cmp';
349 :     $rh_ans_out->{intermediate_response_evaluations} = [@saved_evaluated_ans_hashes];
350 : gage 3319 $rh_ans_out;
351 :     });
352 :     $multi_ans_evaluator;
353 : sh002i 1050 }
354 :    
355 : gage 4762 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 : gage 3319
376 : gage 4762 =head2 Utility functions
377 : gage 3319
378 : gage 4997 # for checking the form of a number or of the <student_ans> field in an answer hash
379 : gage 3319
380 : gage 4762 =cut
381 : gage 3319
382 :    
383 : lr003k 1102 # 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 : sh002i 1050
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 : lr003k 1102 }
397 : sh002i 1050 # 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 : gage 4762 $rh_ans->{answer_form} = 'polar';
401 :     } else {
402 :     $rh_ans->{answer_form} = 'cartesian';
403 : sh002i 1050 }
404 :     $rh_ans;
405 :     }
406 :    
407 :    
408 : apizer 1080
409 : sh002i 1050
410 : gage 4762
411 : sh002i 1050 ## 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 : lr003k 1102
421 : sh002i 1050 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 : lr003k 1102
426 : sh002i 1050 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 : lr003k 1102
432 : sh002i 1050 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 : lr003k 1102
457 : sh002i 1050 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 : lr003k 1102
462 : sh002i 1050 if ($num =~
463 :    
464 :     /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|$number)$/){
465 :     $is_a_number = 1;
466 :     }
467 : lr003k 1102
468 : sh002i 1050 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 : lr003k 1102
492 : sh002i 1050 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 : lr003k 1102
501 : sh002i 1050 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 : lr003k 1102
515 : gage 4762
516 : sh002i 1050 #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 : lr003k 1102
527 : sh002i 1050 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 : gage 4762
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 : sh002i 1050 =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 : lr003k 1102
584 : sh002i 1050 }
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 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
602 : gage 4762
603 : gage 3319 # sub cplx_cmp2 {
604 : gage 4762 ####.............###########
605 : gage 3319 # }
606 : sh002i 1050
607 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
608 : sh002i 1050
609 : gage 3319 # sub cplx_cmp_mult {
610 : gage 4762 ####.............###########
611 : gage 3319 # }
612 : sh002i 1050
613 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
614 : gage 4762
615 : gage 3319 # sub answer_mult{
616 : gage 4762 ####.............###########
617 : gage 3319 # }
618 :     #
619 : gage 4762 # sub multi_cmp_old{
620 :     ####.............###########
621 :     # }
622 : sh002i 1050
623 : gage 4762 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
624 : sh002i 1050
625 : gage 4762 # sub mult_cmp{
626 :     ####.............###########
627 :     # }
628 :    
629 :    
630 : sh002i 1050 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9