[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 4762 - (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 : lr003k 1102
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 :    
91 :     =cut
92 :    
93 :     sub cplx_cmp {
94 :     my $correctAnswer = shift;
95 :     my %cplx_params = @_;
96 : lr003k 1102
97 : sh002i 1050 assign_option_aliases( \%cplx_params,
98 : gage 3319 '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 : lr003k 1102
115 : sh002i 1050 if( $cplx_params{tolType} eq 'relative' ) {
116 : apizer 2986 $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
117 : sh002i 1050 }
118 : lr003k 1102
119 : sh002i 1050 my $formattedCorrectAnswer;
120 :     my $correct_num_answer;
121 :     my $corrAnswerIsString = 0;
122 : lr003k 1102
123 : sh002i 1050
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 : lr003k 1102
133 : sh002i 1050 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 : lr003k 1102
142 : sh002i 1050 my $PGanswerMessage = '';
143 : dpvc 3601
144 : gage 4762 #########################################################################
145 : dpvc 3601 # 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 : gage 4762 # my $correctVal;
159 : dpvc 3601 # 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 : gage 4762 # }
165 :     ########################################################################
166 :     my $correctVal = $correct_num_answer;
167 : lr003k 1102 $correctVal = cplx( $correctVal, 0 ) unless ref($correctVal) =~/^Complex?/ || $corrAnswerIsString == 1;
168 :    
169 :     #construct the answer evaluator
170 : gage 3319 my $answer_evaluator = new AnswerEvaluator;
171 :     $answer_evaluator->{debug} = $cplx_params{debug};
172 : lr003k 1102 $answer_evaluator->ans_hash(
173 : sh002i 1050 correct_ans => $correctVal,
174 : gage 3319 type => "cplx_cmp",
175 :     tolerance => $cplx_params{tolerance},
176 :     tolType => 'absolute', # $cplx_params{tolType},
177 :     original_correct_ans => $formattedCorrectAnswer,
178 : sh002i 1050 answerIsString => $corrAnswerIsString,
179 : gage 3319 answer_form => 'cartesian',
180 : sh002i 1050 );
181 :     my ($in, $formattedSubmittedAnswer);
182 : lr003k 1102 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
183 : sh002i 1050 $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 : lr003k 1102 # do nothing
195 : sh002i 1050 } 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 : lr003k 1102 } 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 : sh002i 1050
208 : lr003k 1102 if ($corrAnswerIsString == 0 ){ # avoiding running compare_cplx when correct answer is a string.
209 : sh002i 1050 $answer_evaluator->install_evaluator(\&compare_cplx, %cplx_params);
210 :     }
211 : lr003k 1102
212 : sh002i 1050
213 :     $answer_evaluator->install_post_filter(\&fix_answers_for_display);
214 :     $answer_evaluator->install_post_filter(\&fix_for_polar_display);
215 : lr003k 1102
216 : gage 4762 $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 : sh002i 1050 $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
226 : gage 4762 $answer_evaluator;
227 : sh002i 1050 }
228 :    
229 :    
230 : gage 4762 =head3 compare_cplx
231 : sh002i 1050
232 : gage 4762 # 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 : lr003k 1102 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 : jj 2958 return $rh_ans;
248 : lr003k 1102 } 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 : apizer 1080
275 : gage 4762 =head3 multi_cmp
276 : sh002i 1050
277 : gage 4762 #
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 : gage 3319
291 :     =cut
292 : sh002i 1050
293 : gage 3319 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 : gage 4761 $multi_ans_evaluator->{debug}=$options{debug} if defined($options{debug});
300 : gage 3319 $multi_ans_evaluator->install_evaluator( sub {
301 :     my $rh_ans = shift;
302 : gage 4761
303 : gage 3319 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 : sh002i 1050 }
331 : gage 3319 # 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 : sh002i 1050 }
336 : apizer 1080
337 : gage 3319
338 : lr003k 1102 }
339 : gage 3319 # construct the final answer hash
340 : gage 4761 my @saved_evaluated_ans_hashes = @evaluated_ans_hashes;
341 : gage 3319 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 : gage 4761 $rh_ans_out->{original_student_ans} = $rh_ans->{student_ans};
347 : gage 3319 $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 : gage 4761 $rh_ans_out->{_filter_name} = 'multi_cmp';
350 :     $rh_ans_out->{intermediate_response_evaluations} = [@saved_evaluated_ans_hashes];
351 : gage 3319 $rh_ans_out;
352 :     });
353 :     $multi_ans_evaluator;
354 : sh002i 1050 }
355 :    
356 : gage 4762 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 : gage 3319
377 : gage 4762 =head2 Utility functions
378 : gage 3319
379 : gage 4762 # for checking the form of a number or of the C<student_ans> field in an answer hash
380 : gage 3319
381 : gage 4762 =cut
382 : gage 3319
383 :    
384 : lr003k 1102 # 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 : sh002i 1050
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 : lr003k 1102 }
398 : sh002i 1050 # 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 : gage 4762 $rh_ans->{answer_form} = 'polar';
402 :     } else {
403 :     $rh_ans->{answer_form} = 'cartesian';
404 : sh002i 1050 }
405 :     $rh_ans;
406 :     }
407 :    
408 :    
409 : apizer 1080
410 : sh002i 1050
411 : gage 4762
412 : sh002i 1050 ## 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 : lr003k 1102
422 : sh002i 1050 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 : lr003k 1102
427 : sh002i 1050 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 : lr003k 1102
433 : sh002i 1050 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 : lr003k 1102
458 : sh002i 1050 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 : lr003k 1102
463 : sh002i 1050 if ($num =~
464 :    
465 :     /^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|$number)$/){
466 :     $is_a_number = 1;
467 :     }
468 : lr003k 1102
469 : sh002i 1050 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 : lr003k 1102
493 : sh002i 1050 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 : lr003k 1102
502 : sh002i 1050 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 : lr003k 1102
516 : gage 4762
517 : 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
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 : lr003k 1102
528 : sh002i 1050 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 : gage 4762
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 : sh002i 1050 =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 : lr003k 1102
585 : sh002i 1050 }
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 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
603 : gage 4762
604 : gage 3319 # sub cplx_cmp2 {
605 : gage 4762 ####.............###########
606 : gage 3319 # }
607 : sh002i 1050
608 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
609 : sh002i 1050
610 : gage 3319 # sub cplx_cmp_mult {
611 : gage 4762 ####.............###########
612 : gage 3319 # }
613 : sh002i 1050
614 : gage 3319 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
615 : gage 4762
616 : gage 3319 # sub answer_mult{
617 : gage 4762 ####.............###########
618 : gage 3319 # }
619 :     #
620 : gage 4762 # sub multi_cmp_old{
621 :     ####.............###########
622 :     # }
623 : sh002i 1050
624 : gage 4762 # this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
625 : sh002i 1050
626 : gage 4762 # sub mult_cmp{
627 :     ####.............###########
628 :     # }
629 :    
630 :    
631 : sh002i 1050 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9