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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : gage 4997
2 : dpvc 3294 loadMacros("Parser.pl");
3 :    
4 :     sub _contextLimitedPolynomial_init {}; # don't load it again
5 :    
6 : gage 4997 =head3 Context("LimitedPolynomial")
7 :    
8 : dpvc 3294 ##########################################################
9 :     #
10 :     # Implements a context in which students can only
11 :     # enter (expanded) polynomials (i.e., sums of multiples
12 :     # of powers of x).
13 :     #
14 :     # Select the context using:
15 :     #
16 :     # Context("LimitedPolynomial");
17 :     #
18 :     # If you set the "singlePowers" flag, then only one monomial of
19 :     # each degree can be included in the polynomial:
20 :     #
21 :     # Context("LimitedPolynomial")->flags->set(singlePowers=>1);
22 :     #
23 :    
24 : dpvc 5051 =cut
25 :    
26 : dpvc 3294 #
27 :     # Handle common checking for BOPs
28 :     #
29 :     package LimitedPolynomial::BOP;
30 :    
31 :     #
32 :     # Do original check and then if the operands are numbers, its OK.
33 :     # Otherwise, do an operator-specific check for if the polynomial is OK.
34 :     # Otherwise report an error.
35 :     #
36 :     sub _check {
37 :     my $self = shift;
38 :     my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
39 :     &{$super."::_check"}($self);
40 :     return if LimitedPolynomial::isConstant($self->{lop}) &&
41 :     LimitedPolynomial::isConstant($self->{rop});
42 :     return if $self->checkPolynomial;
43 :     $self->Error("Your answer doesn't look like a polynomial");
44 :     }
45 :    
46 :     #
47 :     # filled in by subclasses
48 :     #
49 :     sub checkPolynomial {return 0}
50 :    
51 :     #
52 : dpvc 4298 # Check that the exponents of a monomial are OK
53 :     # and record the new exponent array
54 :     #
55 :     sub checkExponents {
56 :     my $self = shift;
57 :     my ($l,$r) = ($self->{lop},$self->{rop});
58 :     LimitedPolynomial::markPowers($l);
59 :     LimitedPolynomial::markPowers($r);
60 :     my $exponents = $self->{exponents} = $r->{exponents};
61 :     delete $r->{exponents}; delete $r->{powers};
62 :     if ($l->{exponents}) {
63 : dpvc 5051 my $single = $self->context->flag('singlePowers');
64 : dpvc 4298 foreach my $i (0..scalar(@{$exponents})-1) {
65 :     $self->Error("A variable can appear only once in each term of a polynomial")
66 :     if $exponents->[$i] && $l->{exponents}[$i] && $single;
67 :     $exponents->[$i] += $l->{exponents}[$i];
68 :     }
69 :     }
70 :     delete $l->{exponents}; delete $l->{powers};
71 :     $self->{isPower} = 1; $self->{isPoly} = $l->{isPoly};
72 :     return 1;
73 :     }
74 :    
75 :     #
76 : dpvc 3294 # Check that the powers of combined monomials are OK
77 :     # and record the new power list
78 :     #
79 :     sub checkPowers {
80 :     my $self = shift;
81 :     my ($l,$r) = ($self->{lop},$self->{rop});
82 : dpvc 5051 my $single = $self->context->flag('singlePowers');
83 : dpvc 4298 LimitedPolynomial::markPowers($l);
84 :     LimitedPolynomial::markPowers($r);
85 : dpvc 3294 $self->{isPoly} = 1;
86 : dpvc 4298 $self->{powers} = $l->{powers} || {}; delete $l->{powers};
87 : dpvc 3294 return 1 unless $r->{powers};
88 :     foreach my $n (keys(%{$r->{powers}})) {
89 :     $self->Error("Polynomials can have at most one term of each degree")
90 :     if $self->{powers}{$n} && $single;
91 :     $self->{powers}{$n} = 1;
92 :     }
93 : dpvc 4298 delete $r->{powers};
94 : dpvc 3294 return 1;
95 :     }
96 :    
97 :     package LimitedPolynomial;
98 :    
99 :     #
100 : dpvc 4298 # Mark a variable as having power 1
101 :     # Mark a monomial as having its given powers
102 :     #
103 :     sub markPowers {
104 :     my $self = shift;
105 :     if ($self->class eq 'Variable') {
106 :     my $vIndex = LimitedPolynomial::getVarIndex($self);
107 :     $self->{index} = $vIndex->{$self->{name}};
108 :     $self->{exponents} = [(0) x scalar(keys %{$vIndex})];
109 :     $self->{exponents}[$self->{index}] = 1;
110 :     }
111 :     if ($self->{exponents}) {
112 :     my $power = join(',',@{$self->{exponents}});
113 :     $self->{powers}{$power} = 1;
114 :     }
115 :     }
116 :    
117 :     #
118 :     # Get a hash of variable names that point to indices
119 :     # within the array of powers for a monomial
120 :     #
121 :     sub getVarIndex {
122 :     my $self = shift;
123 :     my $equation = $self->{equation};
124 :     if (!$equation->{varIndex}) {
125 :     $equation->{varIndex} = {}; my $i = 0;
126 :     foreach my $v ($equation->{context}->variables->names)
127 :     {$equation->{varIndex}{$v} = $i++}
128 :     }
129 :     return $equation->{varIndex};
130 :     }
131 :    
132 :     #
133 : dpvc 3294 # Check for a constant expression
134 :     #
135 :     sub isConstant {
136 :     my $self = shift;
137 :     return 1 if $self->{isConstant} || $self->class eq 'Constant';
138 :     return scalar(keys(%{$self->getVariables})) == 0;
139 :     }
140 :    
141 :     ##############################################
142 :     #
143 :     # Now we get the individual replacements for the operators
144 :     # that we don't want to allow. We inherit everything from
145 :     # the original Parser::BOP class, and just add the
146 :     # polynomial checks here. Note that checkpolynomial
147 :     # only gets called if at least one of the terms is not
148 :     # a number.
149 :     #
150 :    
151 :     package LimitedPolynomial::BOP::add;
152 :     our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::add);
153 :    
154 :     sub checkPolynomial {
155 :     my $self = shift;
156 :     my ($l,$r) = ($self->{lop},$self->{rop});
157 :     $self->Error("Addition is allowed only between monomials")
158 :     if $r->{isPoly};
159 :     $self->checkPowers;
160 :     }
161 :    
162 :     ##############################################
163 :    
164 :     package LimitedPolynomial::BOP::subtract;
165 :     our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::subtract);
166 :    
167 :     sub checkPolynomial {
168 :     my $self = shift;
169 :     my ($l,$r) = ($self->{lop},$self->{rop});
170 :     $self->Error("Subtraction is only allowed between monomials")
171 :     if $r->{isPoly};
172 :     $self->checkPowers;
173 :     }
174 :    
175 :     ##############################################
176 :    
177 :     package LimitedPolynomial::BOP::multiply;
178 :     our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::multiply);
179 :    
180 :     sub checkPolynomial {
181 :     my $self = shift;
182 :     my ($l,$r) = ($self->{lop},$self->{rop});
183 : dpvc 4298 my $lOK = (LimitedPolynomial::isConstant($l) || $l->{isPower} ||
184 :     $l->class eq 'Variable' || ($l->{isPoly} && $l->{isPoly} == 2));
185 :     my $rOK = ($r->{isPower} || $r->class eq 'Variable');
186 :     return $self->checkExponents if $lOK and $rOK;
187 : dpvc 3294 $self->Error("Coefficients must come before variables in a polynomial")
188 :     if LimitedPolynomial::isConstant($r) && ($l->{isPower} || $l->class eq 'Variable');
189 :     $self->Error("Multiplication can only be used between coefficients and variables");
190 :     }
191 :    
192 :     ##############################################
193 :    
194 :     package LimitedPolynomial::BOP::divide;
195 :     our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::divide);
196 :    
197 :     sub checkPolynomial {
198 :     my $self = shift;
199 :     my ($l,$r) = ($self->{lop},$self->{rop});
200 : dpvc 4298 $self->Error("In a polynomial, you can only divide by numbers")
201 : dpvc 3294 unless LimitedPolynomial::isConstant($r);
202 : dpvc 4298 $self->Error("You can only divide a single term by a number")
203 : dpvc 3294 if $l->{isPoly} && $l->{isPoly} == 1;
204 :     $self->{isPoly} = $l->{isPoly};
205 : dpvc 4298 $self->{powers} = $l->{powers}; delete $l->{powers};
206 :     $self->{exponents} = $l->{exponents}; delete $l->{exponents};
207 : dpvc 3294 return 1;
208 :     }
209 :    
210 :     ##############################################
211 :    
212 :     package LimitedPolynomial::BOP::power;
213 :     our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::power);
214 :    
215 :     sub checkPolynomial {
216 :     my $self = shift;
217 :     my ($l,$r) = ($self->{lop},$self->{rop});
218 :     $self->Error("You can only raise a variable to a power in a polynomial")
219 :     unless $l->class eq 'Variable';
220 :     $self->Error("Exponents must be constant in a polynomial")
221 :     unless LimitedPolynomial::isConstant($r);
222 :     my $n = Parser::Evaluate($r);
223 :     $r->Error($$Value::context->{error}{message}) if $$Value::context->{error}{flag};
224 : dpvc 4298 $n = $n->value;
225 : dpvc 3294 $self->Error("Exponents must be positive integers in a polynomial")
226 :     unless $n > 0 && $n == int($n);
227 : dpvc 4298 LimitedPolynomial::markPowers($l);
228 :     $self->{exponents} = $l->{exponents}; delete $l->{exponents};
229 :     foreach my $i (@{$self->{exponents}}) {$i = $n if $i}
230 :     $self->{isPower} = 1;
231 : dpvc 3294 return 1;
232 :     }
233 :    
234 :     ##############################################
235 :     ##############################################
236 :     #
237 :     # Now we do the same for the unary operators
238 :     #
239 :    
240 :     package LimitedPolynomial::UOP;
241 :    
242 :     sub _check {
243 :     my $self = shift;
244 :     my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
245 :     &{$super."::_check"}($self);
246 :     my $op = $self->{op};
247 : jj 3383 return if LimitedPolynomial::isConstant($op);
248 : dpvc 3371 $self->Error("You can only use '%s' with monomials",$self->{def}{string})
249 : dpvc 3294 if $op->{isPoly};
250 :     $self->{isPoly} = 2;
251 : dpvc 4298 $self->{powers} = $op->{powers}; delete $op->{powers};
252 :     $self->{exponents} = $op->{exponents}; delete $op->{exponents};
253 : dpvc 3294 }
254 :    
255 :     sub checkPolynomial {return 0}
256 :    
257 :     ##############################################
258 :    
259 :     package LimitedPolynomial::UOP::plus;
260 :     our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::plus);
261 :    
262 :     ##############################################
263 :    
264 :     package LimitedPolynomial::UOP::minus;
265 :     our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::minus);
266 :    
267 :     ##############################################
268 :     ##############################################
269 :     #
270 :     # Don't allow absolute values
271 :     #
272 :    
273 :     package LimitedPolynomial::List::AbsoluteValue;
274 :     our @ISA = qw(Parser::List::AbsoluteValue);
275 :    
276 :     sub _check {
277 :     my $self = shift;
278 :     $self->SUPER::_check;
279 :     return if LimitedPolynomial::isConstant($self->{coords}[0]);
280 :     $self->Error("Can't use absolute values in polynomials");
281 :     }
282 :    
283 :     ##############################################
284 :     ##############################################
285 :     #
286 :     # Only allow numeric function calls
287 :     #
288 :    
289 :     package LimitedPolynomial::Function;
290 :    
291 :     sub _check {
292 :     my $self = shift;
293 :     my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
294 :     &{$super."::_check"}($self);
295 :     my $arg = $self->{params}->[0];
296 :     return if LimitedPolynomial::isConstant($arg);
297 : dpvc 3371 $self->Error("Function '%s' can only be used with numbers",$self->{name});
298 : dpvc 3294 }
299 :    
300 :    
301 :     package LimitedPolynomial::Function::numeric;
302 :     our @ISA = qw(LimitedPolynomial::Function Parser::Function::numeric);
303 :    
304 :     package LimitedPolynomial::Function::trig;
305 :     our @ISA = qw(LimitedPolynomial::Function Parser::Function::trig);
306 :    
307 : dpvc 4298 package LimitedPolynomial::Function::hyperbolic;
308 :     our @ISA = qw(LimitedPolynomial::Function Parser::Function::hyperbolic);
309 :    
310 : dpvc 3294 ##############################################
311 :     ##############################################
312 :    
313 :     package main;
314 :    
315 :     #
316 :     # Now build the new context that calls the
317 :     # above classes rather than the usual ones
318 :     #
319 :    
320 : dpvc 5051 $context{LimitedPolynomial} = Parser::Context->getCopy(undef,"Numeric");
321 : dpvc 3294 $context{LimitedPolynomial}->operators->set(
322 :     '+' => {class => 'LimitedPolynomial::BOP::add'},
323 :     '-' => {class => 'LimitedPolynomial::BOP::subtract'},
324 :     '*' => {class => 'LimitedPolynomial::BOP::multiply'},
325 :     '* ' => {class => 'LimitedPolynomial::BOP::multiply'},
326 :     ' *' => {class => 'LimitedPolynomial::BOP::multiply'},
327 :     ' ' => {class => 'LimitedPolynomial::BOP::multiply'},
328 :     '/' => {class => 'LimitedPolynomial::BOP::divide'},
329 :     ' /' => {class => 'LimitedPolynomial::BOP::divide'},
330 :     '/ ' => {class => 'LimitedPolynomial::BOP::divide'},
331 :     '^' => {class => 'LimitedPolynomial::BOP::power'},
332 :     '**' => {class => 'LimitedPolynomial::BOP::power'},
333 :     'u+' => {class => 'LimitedPolynomial::UOP::plus'},
334 :     'u-' => {class => 'LimitedPolynomial::UOP::minus'},
335 :     );
336 :     #
337 :     # Remove these operators and functions
338 :     #
339 :     $context{LimitedPolynomial}->lists->set(
340 :     AbsoluteValue => {class => 'LimitedPolynomial::List::AbsoluteValue'},
341 :     );
342 :     $context{LimitedPolynomial}->operators->undefine('_','!','U');
343 : dpvc 4298 $context{LimitedPolynomial}->functions->disable("atan2");
344 : dpvc 3294 #
345 : dpvc 4298 # Hook into the numeric, trig, and hyperbolic functions
346 : dpvc 3294 #
347 : dpvc 4298 foreach ('ln','log','log10','exp','sqrt','abs','int','sgn') {
348 : dpvc 3294 $context{LimitedPolynomial}->functions->set(
349 : dpvc 4298 "$_"=>{class => 'LimitedPolynomial::Function::numeric'}
350 : dpvc 3294 );
351 :     }
352 : dpvc 4298 foreach ('sin','cos','tan','sec','csc','cot',
353 :     'asin','acos','atan','asec','acsc','acot') {
354 : dpvc 3294 $context{LimitedPolynomial}->functions->set(
355 : dpvc 4298 "$_"=>{class => 'LimitedPolynomial::Function::trig'},
356 :     "${_}h"=>{class => 'LimitedPolynomial::Function::hyperbolic'}
357 : dpvc 3294 );
358 :     }
359 :    
360 :     Context("LimitedPolynomial");

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9