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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : dpvc 5444 loadMacros("MathObjects.pl");
2 :     loadMacros("contextInequalities.pl");
3 :    
4 :     sub _contextPiecewiseFunction_init {PiecewiseFunction::Init()}
5 :    
6 :     =head1 Context("PiecewiseFunction");
7 :    
8 : dpvc 5457 ######################################################################
9 :     #
10 :     # This file implements a context in which piecewise-defined functions
11 :     # can be specified by students and problem authors. To use it, add
12 :     #
13 :     # loadMacros("contextPiecewieFunction.pl");
14 :     #
15 :     # and then use
16 :     #
17 :     # Context("PiecewiseFuntion");
18 :     #
19 :     # to select the context for piecewise functions. There are several
20 :     # ways to produce a piecewise function. For example:
21 :     #
22 :     # $f = Compute("x if x >= 0 else -x");
23 :     # $f = Compute("x if x >= 0 else -x if x < 0");
24 :     # $f = Formula("x+1 if x > 2 else 4 if x = 2 else 1-x");
25 :     # $f = PiecewiseFunction("x^2 if 1 < x <= 2 else 2x+1");
26 :     # $f = PiecewiseFunction("1 < x <= 2" => "x^2", "2x+1");
27 :     # $f = PiecewiseFunction("(1,2]" => "x^2", "2x+1");
28 :     # $f = PiecewiseFunction(Interval("(1,2]") => "x^2", "2x+1");
29 :     #
30 :     # You can use either Compute() or Formula() interchangeably to
31 :     # convert a string containing "if" and "else" to the corresponding
32 :     # PiecewiseFunction. The PiecewiseFunction() constructor can
33 :     # also do this, or you can pass it a list of interval=>formula
34 :     # pairs that specify the various branches. If there is an
35 :     # unpaired final formula, it represents the "otherwise" portion
36 :     # of the function (the formula to use of the input is not in
37 :     # any of the given intervals).
38 :     #
39 :     # Note that you can use Inveral, Set, or Union objects in place of
40 :     # the intervals in the specification of a piecewise function.
41 :     #
42 :     # The PiecewiseFunction object TeXifies using a LaTeX "cases"
43 :     # environment, so you can use these objects to produce nice
44 :     # output even if you are not asking a student to enter one.
45 :     # For example:
46 :     #
47 :     # Context("PiecewiseFunction");
48 :     #
49 :     # $f = Formula("1-x if x > 0 else 4 if x = 0 else 1+x if x < 0");
50 :     # $a = random(-2,2,.1);
51 :     #
52 :     # Context()->texStrings;
53 :     # BEGIN_TEXT
54 :     # Suppose \(f(x)=$f\). Then \(f($a)\) = \{ans_rule(20)\}.
55 :     # END_TEXT
56 :     # Context()->normalStrings;
57 :     #
58 :     # ANS($f->eval(x=>$a)->cmp);
59 :     #
60 :     ######################################################################
61 : dpvc 5444
62 :     =cut
63 :    
64 :     package PiecewiseFunction;
65 :    
66 :     #
67 :     # Create the needed context and the constructor function
68 :     #
69 :     sub Init {
70 :     my $context = $main::context{PiecewiseFunction} = Parser::Context->getCopy("Inequalities");
71 :     $context->{value}{PiecewiseFunction} = 'PiecewiseFunction::Function';
72 :     $context->operators->add(
73 :     "if " => {
74 :     precedence =>.31, associativity => 'left', type => 'binary',
75 :     string => ' if ', TeX => '\hbox{ if }', class => 'PiecewiseFunction::BOP::if',
76 :     },
77 :    
78 :     "for " => {
79 :     precedence =>.31, associativity => 'left', type => 'binary',
80 :     string => ' for ', TeX => '\hbox{ for }', class => 'PiecewiseFunction::BOP::if',
81 :     },
82 :    
83 :     "else" => {
84 :     precedence =>.3, associativity => 'right', type => 'binary',
85 :     string => " else\n", TeX => '\hbox{ else }', class => 'PiecewiseFunction::BOP::else',
86 :     },
87 :    
88 :     "in " => {
89 :     precedence => .35, asscoiativity => 'right', type => 'binary',
90 :     string => ' in ', TeX => '\in ', class => 'PiecewiseFunction::BOP::in',
91 :     },
92 :     );
93 :     $context->{value}{InequalityIn} = 'PiecewiseFunction::Interval';
94 :     $context->{value}{'Formula()'} = 'PiecewiseFunction::Formula';
95 :     $context->{cmpDefaults}{PiecewiseFunction} = {reduceSets => 1, requireParenMatch => 1};
96 :    
97 :     main::PG_restricted_eval('sub PiecewiseFunction {Value->Package("PiecewiseFunction")->new(@_)}');
98 :     }
99 :    
100 :     ##################################################
101 :     ##################################################
102 :    
103 :     #
104 :     # A class to implement undefined values (points that
105 :     # are not in the domain of the function)
106 :     #
107 :     package PiecewiseFunction::undefined;
108 :     our @ISA = ('Value');
109 :    
110 :     sub new {
111 :     my $self = shift; my $class = ref($self) || $self;
112 :     my $equation = shift;
113 :     bless {data => [], isUndefined => 1, equation => $equation}, $class;
114 :     }
115 :    
116 :     sub value {undef}
117 :    
118 :     sub string {die "undefined value"}
119 :     sub TeX {die "undefined value"}
120 :     sub perl {"PiecewiseFunction::undefined->new()"}
121 :    
122 :     ##################################################
123 :     #
124 :     # Implement the "if" operator to specify a branch
125 :     # of the piecewise function.
126 :     #
127 :     package PiecewiseFunction::BOP::if;
128 :     our @ISA = ('Parser::BOP');
129 :    
130 :     #
131 :     # Only allow inequalities on the right.
132 :     # Mark the object with identifying values
133 :     #
134 :     sub _check {
135 :     my $self = shift;
136 :     $self->Error("The condition should be an inequality") unless $self->{rop}{isInequality};
137 :     $self->{type} = {%{$self->{lop}->typeRef}};
138 :     $self->{isIf} = $self->{canCompute} = 1;
139 :     $self->{varName} = $self->{rop}{varName} || ($self->context->variables->names)[0];
140 :     }
141 :    
142 :     #
143 :     # Return the function's value if the variable is within
144 :     # the inequality for this branch (otherwise return
145 :     # and undefined value).
146 :     #
147 :     sub eval {
148 :     my $self = shift;
149 :     my $I = $self->{rop}->eval;
150 :     return PiecewiseFunction::undefined->new unless $I->contains($self->{equation}{values}{$self->{varName}});
151 :     return $self->{lop}->eval;
152 :     }
153 :    
154 :     #
155 :     # Make a piecewise function from this branch
156 :     #
157 :     sub Compute {
158 :     my $self = shift; my $context = shift || $self->context; my $method = shift || "new";
159 :     return $context->Package("PiecewiseFunction")->$method($context,$self->flatten($context));
160 :     }
161 :    
162 :     #
163 :     # Make an interval=>formula pair from this item
164 :     #
165 :     sub flatten {
166 :     my $self = shift; my $context = shift || $self->context;
167 :     my $I = $self->{rop}->eval;
168 :     my $f = $context->Package("Formula")->new($context,$self->{lop});
169 :     return ($I => $f);
170 :     }
171 :    
172 :     #
173 :     # Print using the TeX method of the PiecewiseFunction object
174 :     #
175 :     sub TeX {(shift)->Compute(undef,"make")->TeX}
176 :    
177 :     #
178 :     # Make an if-then-else statement that returns the function's
179 :     # value or an undefined value (depending on whether the
180 :     # variable is in the interval or not).
181 :     #
182 :     sub perl {
183 :     my $self = shift; my $parens = shift;
184 :     my $I = $self->{rop}->eval; my $x = "\$".$self->{varName};
185 :     my $condition = $I->perl.'->contains('.$x.')';
186 :     my $lop = $self->{lop}->perl; my $rop = 'PiecewiseFunction::undefined->new';
187 :     return '('.$condition.' ? '.$lop.' : '.$rop.')'
188 :     }
189 :    
190 :     ##################################################
191 :     #
192 :     # Implement the "else" operator to join the
193 :     # different branches of the function.
194 :     #
195 :     package PiecewiseFunction::BOP::else;
196 :     our @ISA = ('Parser::BOP');
197 :    
198 :     #
199 :     # Make sure there is an "if" that goes with this else.
200 :     #
201 :     sub _check {
202 :     my $self = shift;
203 :     $self->Error("You must have an 'if' to the left of 'else'") unless $self->{lop}{isIf};
204 :     $self->{type} = {%{$self->{lop}->typeRef}};
205 :     $self->{isElse} = $self->{canCompute} = 1;
206 :     }
207 :    
208 :     #
209 :     # Use the result of the "if" to decide which value to return.
210 :     #
211 :     sub eval {
212 :     my $self = shift; my $lop = $self->{lop}->eval;
213 :     return (ref($lop) eq 'PiecewiseFunction::undefined' ? $self->{rop}->eval : $lop);
214 :     }
215 :    
216 :     #
217 :     # Make a PiecewiseFunction from the (nested) if-then-else values.
218 :     #
219 :     sub Compute {
220 :     my $self = shift; my $context = shift || $self->context; my $method = shift || "new";
221 :     return $context->Package("PiecewiseFunction")->$method($context,$self->flatten($context))
222 :     }
223 :    
224 :     #
225 :     # Recursively flatten the if-then-else tree to a list
226 :     # of interval=>formula pairs.
227 :     #
228 :     sub flatten {
229 :     my $self = shift; my $context = shift || $self->context;
230 :     my $flatten = $self->{rop}->can("flatten");
231 :     return ($self->{lop}->flatten($context),&$flatten($self->{rop},$context)) if $flatten;
232 :     my $f = $context->Package("Formula")->new($context,$self->{rop});
233 :     return ($self->{lop}->flatten($context),$f);
234 :     }
235 :    
236 :     #
237 :     # Don't do extra parens for nested else's.
238 :     #
239 :     sub string {
240 :     my ($self,$precedence,$showparens,$position,$outerRight) = @_;
241 :     my $string; my $bop = $self->{def};
242 :     $position = '' unless defined($position);
243 :     $showparens = '' unless defined($showparens);
244 :     my $addparens = defined($precedence) && ($showparens eq 'all' || $precedence > $bop->{precedence});
245 :     $outerRight = !$addparens && ($outerRight || $position eq 'right');
246 :    
247 :     $string = $self->{lop}->string($bop->{precedence},$bop->{leftparens},'left',$outerRight).
248 :     $bop->{string}.
249 :     $self->{rop}->string($bop->{precedence});
250 :    
251 :     $string = $self->addParens($string) if $addparens;
252 :     return $string;
253 :     }
254 :    
255 :     #
256 :     # Use the PiecewiseFunction TeX method.
257 :     #
258 :     sub TeX {(shift)->Compute(undef,"make")->TeX}
259 :    
260 :     #
261 :     # Use an if-then-else to determine the value to use.
262 :     #
263 :     sub perl {
264 :     my $self = shift; my $parens = shift;
265 :     my $I = $self->{lop}{rop}->eval; my $x = "\$".$self->{lop}{varName};
266 :     my $condition = $I->perl.'->contains('.$x.')';
267 :     my $lop = $self->{lop}{lop}->perl; my $rop = $self->{rop}->perl;
268 :     return '('.$condition.' ? '.$lop.' : '.$rop.')';
269 :     }
270 :    
271 :    
272 :     ##################################################
273 :     #
274 :     # Implement an "in" operator for "x in (a,b)" as an
275 :     # alternative to inequality notation.
276 :     #
277 :     package PiecewiseFunction::BOP::in;
278 :     our @ISA = ('Parser::BOP');
279 :    
280 :     #
281 :     # Make sure the variable is to the left and an interval,
282 :     # set, or union is to the right.
283 :     #
284 :     sub _check {
285 :     my $self = shift;
286 :     $self->{type} = Value::Type("Interval",2);
287 :     $self->{isInequality} = 1;
288 :     $self->Error("There should be a variable to the left of '%s'",$self->{bop})
289 :     unless $self->{lop}->class eq 'Variable';
290 :     $self->Error("There should be a set of numbers to the right of '%s'",$self->{bop})
291 :     unless $self->{rop}->isSetOfReals;
292 :     $self->{varName} = $self->{lop}{name};
293 :     delete $self->{equation}{variables}{$self->{lop}{name}} if $self->{lop}{isNew};
294 :     $self->{lop} = Inequalities::DummyVariable->new($self->{equation},$self->{lop}{name},$self->{lop}{ref});
295 :     }
296 :    
297 :     #
298 :     # Call this an Inequality so it will be allowed to the
299 :     # right of "if" operators.
300 :     #
301 :     sub _eval {
302 :     my $self = shift;
303 :     bless $self->Package("Inequality")->new($_[1],$self->{varName}),
304 :     $self->Package("InequalityIn");
305 :     }
306 :    
307 :     ##################################################
308 :     #
309 :     # This implements the "in" operator as in inequality.
310 :     # We inherit all the inequality methods, and simply
311 :     # need to handle the string and TeX output. The
312 :     # underlying type is still an Inerval.
313 :     #
314 :     package PiecewiseFunction::Interval;
315 :     our @ISA = ("Inequalities::Interval");
316 :    
317 :     sub string {
318 :     my $self = shift; my $equation = shift;
319 :     my $x = $self->{varName} || ($self->context->variables->names)[0];
320 :     $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
321 :     $x . ' in ' . $self->demote->string;
322 :     }
323 :    
324 :     sub TeX {
325 :     my $self = shift; my $equation = shift;
326 :     my $x = $self->{varName} || ($self->context->variables->names)[0];
327 :     $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
328 :     $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
329 :     $x . '\in ' . $self->demote->TeX;
330 :     }
331 :    
332 :     ##################################################
333 :     ##################################################
334 :     #
335 :     # This implements the PiecewiseFunction. It is an unusual mix
336 :     # of a Value object and a Formula object. It looks like a
337 :     # Formula for the most part, but doesn't have the same internal
338 :     # structure. Most of the Formula methods have been provided
339 :     # so that eval, substitute, reduce, etc will be applied to all
340 :     # the branches.
341 :     #
342 :     package PiecewiseFunction::Function;
343 :     our @ISA = ('Value', 'Value::Formula');
344 :    
345 :     #
346 :     # Create the PiecewiseFunction object, with error reporting
347 :     # for problems in the data.
348 :     #
349 :     # Usage: PiecewiseFunction("formula")
350 :     # PiecewiseFunction(I1 => f1, I2 => f2, ... , fn);
351 :     #
352 :     # In the first case, the formula is parsed for "if" and "else" values
353 :     # to produce the function. In the second, the function is given
354 :     # by interval/formula pairs that associate what function to map over
355 :     # interval. If there is an unpaired formula at the end, it is
356 :     # the "otherwise" formula that will be used whenever the input
357 :     # does not fall into one of the given intervals.
358 :     #
359 :     # Note that the intervals above actually can be Interval, Set,
360 :     # or Union objects, not just plain intervals.
361 :     #
362 :     sub new {
363 :     my $self = shift; my $class = ref($self) || $self;
364 :     my $context = (Value::isContext($_[0]) ? shift : $self->context);
365 :     Value->Error("You must provide at least one Formula for a Piecewise Function") unless scalar(@_);
366 :     my $F = shift; $F = [$F,@_] if scalar(@_);
367 :     return $F if ref($F) eq $class;
368 :     unless (ref($F) eq 'ARRAY') {
369 :     $F = $context->Package("Formula")->new($context,$F);
370 :     if ($F->{tree}->can("Compute")) {
371 :     $F = $F->{tree}->Compute($context);
372 :     return $F if ref($F) eq $class;
373 :     }
374 :     $F = [$F];
375 :     }
376 :     my $pf = bless {data => [], context => $context, isPiecewiseFunction => 1}, $class;
377 :     my $x = ''; $pf->{variables} = {};
378 :     while (scalar(@$F) > 1) {
379 :     my $I = shift(@$F); my $f = shift(@$F);
380 :     $I = $context->Package("Interval")->new($context,$I) unless Value::classMatch($I,"Interval","Set","Union");
381 :     $f = $context->Package("Formula")->new($context,$f) unless Value::isFormula($f);
382 :     $I->{equation} = $f->{equation} = $pf; ### Transfer equation flag?
383 :     push(@{$pf->{data}},[$I,$f]);
384 :     $x = $I->{varName} unless $x;
385 :     foreach my $v (keys %{$f->{variables}}) {$pf->{variables}{$v} = 1}
386 :     }
387 :     if (scalar(@$F)) {
388 :     $pf->{otherwise} = $context->Package("Formula")->new($context,shift(@$F));
389 :     $pf->{otherwise}{equation} = $pf; ### transfer?
390 :     foreach my $v (keys %{$pf->{otherwise}{variables}}) {$pf->{variables}{$v} = 1}
391 :     }
392 :     $pf->{varName} = ($x || ($context->variables->names)[0]);
393 :     $pf->{variables}{$pf->{varName}} = 1;
394 :     $pf->check;
395 :     return $pf;
396 :     }
397 :    
398 :     #
399 :     # Create a PiecewiseFunction without error checking (so overlapping intervals,
400 :     # incorrect variables, and so on could appear).
401 :     #
402 :     sub make {
403 :     my $self = shift; my $class = ref($self) || $self;
404 :     my $context = (Value::isContext($_[0]) ? shift : $self->context);
405 :     my $pf = bless {data => [], context => $context, isPiecewiseFunction => 1}, $class;
406 :     my $x = '';
407 :     while (scalar(@_) > 1) {
408 :     my $I = shift; my $f = shift;
409 :     $I->{equation} = $f->{equation} = $pf; ### Transfer equation flag?
410 :     $x = $I->{varName} unless $x;
411 :     push(@{$pf->{data}},[$I,$f]);
412 :     $self->{typeRef} = $f->typeRef unless defined $self->{typeRef};
413 :     foreach my $v (keys %{$f->{variables}}) {$pf->{variables}{$v} = 1}
414 :     }
415 :     if (scalar(@_)) {
416 :     $pf->{otherwise} = shift;
417 :     $pf->{otherwise}{equation} = $pf; ### transfer?
418 :     foreach my $v (keys %{$f->{otherwise}{variables}}) {$pf->{variables}{$v} = 1}
419 :     }
420 :     $pf->{varName} = ($x || ($context->variables->names)[0]);
421 :     $pf->{variables}{$pf->{varName}} = 1;
422 :     return $pf;
423 :     }
424 :    
425 :     #
426 :     # Do the consistency checks for the separate branches.
427 :     #
428 :     sub check {
429 :     my $self = shift;
430 :     $self->checkVariable;
431 :     $self->checkMultipleValued;
432 :     $self->checkTypes;
433 :     }
434 :    
435 :     #
436 :     # Check that all the inequalities are for the same variable.
437 :     #
438 :     sub checkVariable {
439 :     my $self = shift; my $context = $self->context;
440 :     my $x = $self->{varName};
441 :     foreach my $If (@{$self->{data}}) {
442 :     my ($I,$f) = @$If;
443 :     $I = $If->[0] = $context->Package("Inequality")->new($context,$I,$x)
444 :     unless $I->classMatch("Inequality");
445 :     Value->Error("All the intervals must use the same variable") if $I->{varName} ne $x;
446 :     }
447 :     }
448 :    
449 :     #
450 :     # Check that no domain intervals overlap.
451 :     #
452 :     sub checkMultipleValued {
453 :     my $self = shift;
454 :     my @D = $self->domainUnion->sort->value;
455 :     foreach my $i (0..scalar(@D)-2) {
456 :     my ($I,$J) = @D[$i,$i+1];
457 :     Value->Error("A piecewise function can't have overlapping domain intervals")
458 :     if $I->intersects($J);
459 :     }
460 :     }
461 :    
462 :     #
463 :     # Check that all the branches return the same type of result.
464 :     #
465 :     sub checkTypes {
466 :     my $self = shift;
467 :     foreach my $If (@{$self->{data}}) {$self->checkType($If->[1])}
468 :     $self->checkType($self->{otherwise}) if defined $self->{otherwise};
469 :     }
470 :    
471 :     sub checkType {
472 :     my $self = shift; my $f = shift;
473 :     if (defined $self->{typeRef}) {
474 :     Value->Error("All the formulas must produce the same type of answer")
475 :     unless Parser::Item::typeMatch($self->{typeRef},$f->typeRef);
476 :     } else {$self->{typeRef} = $f->typeRef}
477 :     }
478 :    
479 :     #
480 :     # This is always considered a formula.
481 :     #
482 :     sub isConstant {0}
483 :    
484 :     #
485 :     # Look through the branches for the one that contains
486 :     # the variable's value, and evaluate it. If not in
487 :     # any of the intervals, use the "otherwise" value,
488 :     # or die with no value if there isn't one.
489 :     #
490 :     sub eval {
491 :     my $self = shift;
492 :     $self->setValues(@_); my $x = $self->{values}{$self->{varName}}; $self->unsetValues;
493 :     foreach my $If (@{$self->{data}}) {
494 :     my ($I,$f) = @{$If};
495 :     return $f->eval(@_) if $I->contains($x);
496 :     }
497 :     return $self->{otherwise}->eval(@_) if defined $self->{otherwise};
498 :     die "undefined value";
499 :     }
500 :    
501 :     #
502 :     # Reduce each branch individually.
503 :     #
504 :     sub reduce {
505 :     my $self = shift; my @cases = ();
506 :     foreach my $If (@{$self->{data}}) {
507 :     my ($I,$f) = @{$If};
508 :     push(@cases,$I->copy => $f->reduce(@_));
509 :     }
510 :     push(@cases,$self->{otherwise}->reduce(@_)) if defined $self->{otherwise};
511 :     return $self->make(@cases);
512 :     }
513 :    
514 :     #
515 :     # Substitute into each branch individually.
516 : dpvc 5446 # If the function's variable is substituted, then
517 :     # if it is a constant, find the branch for that value
518 :     # and substitute into that, otherwise if it is
519 :     # just another variable, replace the variable
520 :     # in the inequalities as well as the formulas.
521 :     # Otherwise, just replace in the formulas.
522 : dpvc 5444 #
523 :     sub substitute {
524 : dpvc 5446 my $self = shift;
525 :     my @cases = (); my $x = $self->{varName};
526 :     $self->setValues(@_); my $a = $self->{values}{$x}; $self->unsetValues(@_);
527 :     if (defined $a) {
528 :     if (!Value::isFormula($a)) {
529 :     my $f = $self->getFunctionFor($a);
530 :     die "undefined value" unless defined $f;
531 :     return $f->substitute(@_);
532 :     }
533 :     $x = $a->{tree}{name} if $a->{tree}->class eq 'Variable';
534 :     }
535 : dpvc 5444 foreach my $If (@{$self->{data}}) {
536 :     my ($I,$f) = @{$If};
537 : dpvc 5446 $I = $I->copy; if ($x ne $I->{varName}) {$I->{varName} = $x; $I->updateParts}
538 :     push(@cases,$I => $f->substitute(@_));
539 : dpvc 5444 }
540 :     push(@cases,$self->{otherwise}->substitute(@_)) if defined $self->{otherwise};
541 :     return $self->make(@cases);
542 :     }
543 :    
544 :    
545 :     #
546 :     # Return the domain of the function (will be (-inf,inf) if
547 :     # there is an "otherwise" formula.
548 :     #
549 :     sub domain {
550 :     my $self = shift;
551 :     return $self->domainR if defined $self->{otherwise};
552 :     return $self->domainUnion->reduce;
553 :     }
554 :    
555 :     #
556 :     # The set (-inf,inf).
557 :     #
558 :     sub domainR {
559 :     my $self = shift; my $context = $self->context;
560 :     my $Infinity = $context->Package("Infinity")->new($context);
561 :     return $context->Package("Interval")->make($context,'(',-$Infinity,$Infinity,')');
562 :     }
563 :    
564 :     #
565 :     # The domain formed by the explicitly given intervals
566 :     # (excludes the "otherwise" portion, if any)
567 :     #
568 :     sub domainUnion {
569 :     my $self = shift; my $context = $self->context;
570 :     my @cases = (); foreach my $If (@{$self->{data}}) {push(@cases,$If->[0])}
571 :     return $context->Package("Union")->make($context,@cases);
572 :     }
573 :    
574 :     #
575 :     # Creates a copy of the PiecewiseFunction where the "otherwise"
576 :     # formula has been given explicit intervals within the object.
577 :     # (This makes it easier to compare two PiecewiseFormulas
578 :     # interval by interval.)
579 :     #
580 :     sub noOtherwise {
581 :     my $self = (shift)->copy; my $context = $self->context;
582 :     return $self unless defined $self->{otherwise};
583 :     my $otherwise = $self->domainR - $self->domainUnion->reduce;
584 :     return $self if $otherwise->isEmpty;
585 :     $otherwise = $context->Package("Union")->new($context,$otherwise) unless $otherwise->type eq 'Union';
586 :     foreach my $I ($otherwise->value) {
587 :     my $D = $context->Package("Inequality")->new($context,$I,$self->{varName});
588 :     push(@{$self->{data}},[$D,$self->{otherwise}]);
589 :     }
590 :     delete $self->{otherwise};
591 :     foreach my $If (@{$self->{data}}) {$If->[0]{equation} = $If->[1]{equation} = $self}
592 :     return $self;
593 :     }
594 :    
595 :     #
596 : dpvc 5446 # Look up the function for the nth branch (or the "otherwise"
597 :     # function if n is omitted or too big or too small).
598 :     #
599 :     sub getFunction {
600 :     my $self = shift; my $n = shift;
601 :     return $self->{otherwise} if !defined $n || $n < 1 || $n > $self->length;
602 :     return $self->{data}[$n-1][1];
603 :     }
604 :    
605 :     #
606 :     # Look up the domain for the nth branch (or the "otherwise"
607 :     # domain if n is omitted or too big or too small).
608 :     #
609 :     sub getDomain {
610 :     my $self = shift; my $n = shift;
611 :     return $self->Package("Inequality")->new($self->context,
612 :     $self->domainR - $self->domainUnion,$self->{varName})
613 :     if !defined $n || $n < 1 || $n > $self->length;
614 :     return $self->{data}[$n-1][0];
615 :     }
616 :    
617 :     #
618 :     # Get the function for the given value of the variable
619 :     # (or undef if there is none).
620 :     #
621 :     sub getFunctionFor {
622 :     my $self = shift; my $x = shift;
623 :     foreach my $If (@{$self->{data}}) {
624 :     my ($I,$f) = @$If;
625 :     return $f if $I->contains($x);
626 :     }
627 :     return $self->{otherwise};
628 :     }
629 :    
630 :     #
631 : dpvc 5444 # Implements the <=> operator (really only handles equality ir not)
632 :     #
633 :     sub compare {
634 :     my ($l,$r,$flag) = @_; my $self = $l;
635 :     my $context = $self->context; my $result;
636 :     $r = $context->Package("PiecewiseFunction")->new($context,$r) unless Value::classMatch($r,"PiecewiseFunction");
637 :     Value::Error("Formulas from different contexts can't be compared")
638 :     unless $l->{context} == $r->{context};
639 :     $l = $l->noOtherwise; $r = $r->noOtherwise;
640 :     $result = $l->compareDomains($r); return $result if $result;
641 :     $result = $l->compareFormulas($r); return $result if $result;
642 :     return 0;
643 :     }
644 :    
645 :     #
646 :     # Check that the funciton domains have the same number of
647 :     # components, and that those components agree, interval by interval.
648 :     #
649 :     sub compareDomains {
650 :     my $self = shift; my $other = shift;
651 :     my @D0 = $self->domainUnion->sort->value;
652 :     my @D1 = $other->domainUnion->sort->value;
653 :     return scalar(@D0) <=> scalar(@D1) unless scalar(@D0) == scalar(@D1);
654 :     foreach my $i (0..$#D0) {
655 :     my $result = ($D0[$i] <=> $D1[$i]);
656 :     return $result if $result;
657 :     }
658 :     return 0;
659 :     }
660 :    
661 :     #
662 :     # Now that the intervals are known to agree, compare
663 :     # the individual functions on each interval. Do an
664 :     # appropriate check depending on the type of each
665 :     # branch: Interval, Set, or Union.
666 :     #
667 :     sub compareFormulas {
668 :     my $self = shift; my $other = shift;
669 :     my @D0 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $self->value);
670 :     my @D1 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $other->value);
671 :     foreach my $i (0..$#D0) {
672 :     my ($D,$f0,$f1) = (@{$D0[$i]},$D1[$i][1]);
673 :     my $method = "compare".$D->type;
674 :     my $result = $self->$method($D,$f0,$f1);
675 :     return $result if $result;
676 :     }
677 :     return 0;
678 :     }
679 :    
680 :     #
681 :     # Use the Interval to determine the limits for use
682 :     # in comparing the two functions.
683 :     #
684 :     sub compareInterval {
685 :     my $self = shift; my ($D,$f0,$f1) = @_;
686 :     my ($a,$b) = $D->value; $a = $a->value; $b = $b=>value;
687 :     return $f0 == $f1 if $D->{leftInfinite} && $D->{rightInfinite};
688 :     $a = $b - 2 if $D->{leftInfinite};
689 :     $b = $a + 2 if $D->{rightInfinite};
690 :     return $f0->with(limits=>[$a,$b]) <=> $f1;
691 :     }
692 :    
693 :     #
694 :     # For a set, check that the functions agree on every point.
695 :     #
696 :     sub compareSet {
697 :     my $self = shift; my ($D,$f0,$f1) = @_;
698 :     my $x = $self->{varName};
699 :     foreach my $a ($self->value) {
700 :     my $result = $f0->eval($x=>$a) <=> $f1->eval($x=>$a);
701 :     return $result if $result;
702 :     }
703 :     return 0;
704 :     }
705 :    
706 :     #
707 :     # For a union, do the appropriate check for
708 :     # each object in the union.
709 :     #
710 :     sub compareUnion {
711 :     my $self = shift; my ($D,$f0,$f1) = @_;
712 :     foreach my $S ($self->value) {
713 :     my $method = "compare".$S->type;
714 :     my $result = $self->$method($D,$f0,$f1);
715 :     return $result if $result;
716 :     }
717 :     return 0;
718 :     }
719 :    
720 :    
721 :     #
722 :     # Stringify using newlines at after each "else".
723 :     # (Otherwise the student and correct answer can
724 :     # get unacceptably long.)
725 :     #
726 :     sub string {
727 :     my $self = shift; my @cases = ();
728 :     foreach my $If (@{$self->{data}}) {
729 :     my ($I,$f) = @{$If};
730 :     push(@cases,$f->string." if ".$I->string);
731 :     }
732 :     push(@cases,$self->{otherwise}->string) if defined $self->{otherwise};
733 :     join(" else\n",@cases);
734 :     }
735 :    
736 :     #
737 :     # TeXify using a "cases" LaTeX environment.
738 :     #
739 :     sub TeX {
740 :     my $self = shift; my @cases = ();
741 :     foreach my $If (@{$self->{data}}) {
742 :     my ($I,$f) = @{$If};
743 : dpvc 5545 push(@cases,'\displaystyle{'.$f->TeX."}&\\text{if}\\ ".$I->TeX);
744 : dpvc 5444 }
745 :     if (scalar(@cases)) {
746 :     push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{otherwise}') if defined $self->{otherwise};
747 :     return '\begin{cases}'.join('\cr'."\n",@cases).'\end{cases}';
748 :     } else {
749 :     return $self->{otherwise}->TeX;
750 :     }
751 :     }
752 :    
753 :     #
754 :     # Create a code segment that returns the correct value depending on which
755 :     # interval contains the variable's value (or an undefined value).
756 :     #
757 :     sub perl {
758 :     my $self = shift; my $x = "\$".$self->{varName};
759 :     my @cases = ();
760 :     foreach my $If (@{$self->{data}}) {
761 :     my ($I,$f) = @{$If};
762 :     push(@cases,'return '.$f->perl.' if '.$I->perl.'->contains('.$x.');');
763 :     }
764 :     if (defined($self->{otherwise})) {push(@cases,'return '.$self->{otherwise}->perl.';')}
765 :     else {push(@cases,'die "undefined value";')}
766 :     return join("\n",@cases);
767 :     }
768 :    
769 :    
770 :     #
771 :     # Handle the types correctly for error messages and such.
772 :     #
773 :     sub class {"PiecewiseFunction"}
774 :     sub showClass {
775 :     my $self = shift;
776 :     my $f = $self->{data}[0][1]; $f = $self->{otherwise} unless defined $f;
777 :     'a Formula that returns '.Value::showType($f->{tree});
778 :     }
779 :    
780 :     sub type {(shift)->{typeRef}{name}}
781 :     sub typeRef {(shift)->{typeRef}}
782 :    
783 :     #
784 :     # Allow comparison only when the two functions return
785 :     # the same type of result.
786 :     #
787 :     sub typeMatch {
788 :     my $self = shift; my $other = shift; my $ans = shift;
789 :     return $self->type eq $other->type;
790 :     }
791 :    
792 :     ##################################################
793 :     #
794 :     # Overrides the Formula() command so that if
795 :     # the result is a PiecewiseFunction, it is
796 :     # turned into one automatically. Conversely,
797 :     # if a PiecewiseFunction is put into Formula(),
798 :     # this will turn it into a Formula.
799 :     #
800 :     package PiecewiseFunction::Formula;
801 :     our @ISA = ('Value::Formula');
802 :    
803 :     sub new {
804 :     my $self = shift; my $f;
805 :     if (scalar(@_) == 1 && Value::classMatch($_[0],"PiecewiseFunction")) {
806 :     $f = $_[0]->string; $f =~ s/\n/ /g;
807 :     $f = $self->Package("Formula")->new($f);
808 :     } else {
809 :     $f = $self->Package("Formula")->new(@_);
810 :     $f = $f->{tree}->Compute if $f->{tree}{canCompute};
811 :     }
812 :     return $f;
813 :     }
814 :    
815 :     ######################################################################
816 :    
817 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9