[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 5444 - (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 :     ######################################################################
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 :    
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 :     #
517 :     # ### FIXME: only allow the variable to be substituted
518 :     # by another variable, and change the intervals as well.
519 :     # If it is a constant, then evaluate?
520 :     #
521 :     sub substitute {
522 :     my $self = shift; my @cases = ();
523 :     foreach my $If (@{$self->{data}}) {
524 :     my ($I,$f) = @{$If};
525 :     push(@cases,$I->copy => $f->substitute(@_));
526 :     }
527 :     push(@cases,$self->{otherwise}->substitute(@_)) if defined $self->{otherwise};
528 :     return $self->make(@cases);
529 :     }
530 :    
531 :    
532 :     #
533 :     # Return the domain of the function (will be (-inf,inf) if
534 :     # there is an "otherwise" formula.
535 :     #
536 :     sub domain {
537 :     my $self = shift;
538 :     return $self->domainR if defined $self->{otherwise};
539 :     return $self->domainUnion->reduce;
540 :     }
541 :    
542 :     #
543 :     # The set (-inf,inf).
544 :     #
545 :     sub domainR {
546 :     my $self = shift; my $context = $self->context;
547 :     my $Infinity = $context->Package("Infinity")->new($context);
548 :     return $context->Package("Interval")->make($context,'(',-$Infinity,$Infinity,')');
549 :     }
550 :    
551 :     #
552 :     # The domain formed by the explicitly given intervals
553 :     # (excludes the "otherwise" portion, if any)
554 :     #
555 :     sub domainUnion {
556 :     my $self = shift; my $context = $self->context;
557 :     my @cases = (); foreach my $If (@{$self->{data}}) {push(@cases,$If->[0])}
558 :     return $context->Package("Union")->make($context,@cases);
559 :     }
560 :    
561 :     #
562 :     # Creates a copy of the PiecewiseFunction where the "otherwise"
563 :     # formula has been given explicit intervals within the object.
564 :     # (This makes it easier to compare two PiecewiseFormulas
565 :     # interval by interval.)
566 :     #
567 :     sub noOtherwise {
568 :     my $self = (shift)->copy; my $context = $self->context;
569 :     return $self unless defined $self->{otherwise};
570 :     my $otherwise = $self->domainR - $self->domainUnion->reduce;
571 :     return $self if $otherwise->isEmpty;
572 :     $otherwise = $context->Package("Union")->new($context,$otherwise) unless $otherwise->type eq 'Union';
573 :     foreach my $I ($otherwise->value) {
574 :     my $D = $context->Package("Inequality")->new($context,$I,$self->{varName});
575 :     push(@{$self->{data}},[$D,$self->{otherwise}]);
576 :     }
577 :     delete $self->{otherwise};
578 :     foreach my $If (@{$self->{data}}) {$If->[0]{equation} = $If->[1]{equation} = $self}
579 :     return $self;
580 :     }
581 :    
582 :     #
583 :     # Implements the <=> operator (really only handles equality ir not)
584 :     #
585 :     sub compare {
586 :     my ($l,$r,$flag) = @_; my $self = $l;
587 :     my $context = $self->context; my $result;
588 :     $r = $context->Package("PiecewiseFunction")->new($context,$r) unless Value::classMatch($r,"PiecewiseFunction");
589 :     Value::Error("Formulas from different contexts can't be compared")
590 :     unless $l->{context} == $r->{context};
591 :     $l = $l->noOtherwise; $r = $r->noOtherwise;
592 :     $result = $l->compareDomains($r); return $result if $result;
593 :     $result = $l->compareFormulas($r); return $result if $result;
594 :     return 0;
595 :     }
596 :    
597 :     #
598 :     # Check that the funciton domains have the same number of
599 :     # components, and that those components agree, interval by interval.
600 :     #
601 :     sub compareDomains {
602 :     my $self = shift; my $other = shift;
603 :     my @D0 = $self->domainUnion->sort->value;
604 :     my @D1 = $other->domainUnion->sort->value;
605 :     return scalar(@D0) <=> scalar(@D1) unless scalar(@D0) == scalar(@D1);
606 :     foreach my $i (0..$#D0) {
607 :     my $result = ($D0[$i] <=> $D1[$i]);
608 :     return $result if $result;
609 :     }
610 :     return 0;
611 :     }
612 :    
613 :     #
614 :     # Now that the intervals are known to agree, compare
615 :     # the individual functions on each interval. Do an
616 :     # appropriate check depending on the type of each
617 :     # branch: Interval, Set, or Union.
618 :     #
619 :     sub compareFormulas {
620 :     my $self = shift; my $other = shift;
621 :     my @D0 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $self->value);
622 :     my @D1 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $other->value);
623 :     foreach my $i (0..$#D0) {
624 :     my ($D,$f0,$f1) = (@{$D0[$i]},$D1[$i][1]);
625 :     my $method = "compare".$D->type;
626 :     my $result = $self->$method($D,$f0,$f1);
627 :     return $result if $result;
628 :     }
629 :     return 0;
630 :     }
631 :    
632 :     #
633 :     # Use the Interval to determine the limits for use
634 :     # in comparing the two functions.
635 :     #
636 :     sub compareInterval {
637 :     my $self = shift; my ($D,$f0,$f1) = @_;
638 :     my ($a,$b) = $D->value; $a = $a->value; $b = $b=>value;
639 :     return $f0 == $f1 if $D->{leftInfinite} && $D->{rightInfinite};
640 :     $a = $b - 2 if $D->{leftInfinite};
641 :     $b = $a + 2 if $D->{rightInfinite};
642 :     return $f0->with(limits=>[$a,$b]) <=> $f1;
643 :     }
644 :    
645 :     #
646 :     # For a set, check that the functions agree on every point.
647 :     #
648 :     sub compareSet {
649 :     my $self = shift; my ($D,$f0,$f1) = @_;
650 :     my $x = $self->{varName};
651 :     foreach my $a ($self->value) {
652 :     my $result = $f0->eval($x=>$a) <=> $f1->eval($x=>$a);
653 :     return $result if $result;
654 :     }
655 :     return 0;
656 :     }
657 :    
658 :     #
659 :     # For a union, do the appropriate check for
660 :     # each object in the union.
661 :     #
662 :     sub compareUnion {
663 :     my $self = shift; my ($D,$f0,$f1) = @_;
664 :     foreach my $S ($self->value) {
665 :     my $method = "compare".$S->type;
666 :     my $result = $self->$method($D,$f0,$f1);
667 :     return $result if $result;
668 :     }
669 :     return 0;
670 :     }
671 :    
672 :    
673 :     #
674 :     # Stringify using newlines at after each "else".
675 :     # (Otherwise the student and correct answer can
676 :     # get unacceptably long.)
677 :     #
678 :     sub string {
679 :     my $self = shift; my @cases = ();
680 :     foreach my $If (@{$self->{data}}) {
681 :     my ($I,$f) = @{$If};
682 :     push(@cases,$f->string." if ".$I->string);
683 :     }
684 :     push(@cases,$self->{otherwise}->string) if defined $self->{otherwise};
685 :     join(" else\n",@cases);
686 :     }
687 :    
688 :     #
689 :     # TeXify using a "cases" LaTeX environment.
690 :     #
691 :     sub TeX {
692 :     my $self = shift; my @cases = ();
693 :     foreach my $If (@{$self->{data}}) {
694 :     my ($I,$f) = @{$If};
695 :     push(@cases,'\displaystyle{'.$f->TeX."}&\\text{if \$".$I->TeX."\$}");
696 :     }
697 :     if (scalar(@cases)) {
698 :     push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{otherwise}') if defined $self->{otherwise};
699 :     return '\begin{cases}'.join('\cr'."\n",@cases).'\end{cases}';
700 :     } else {
701 :     return $self->{otherwise}->TeX;
702 :     }
703 :     }
704 :    
705 :     #
706 :     # Create a code segment that returns the correct value depending on which
707 :     # interval contains the variable's value (or an undefined value).
708 :     #
709 :     sub perl {
710 :     my $self = shift; my $x = "\$".$self->{varName};
711 :     my @cases = ();
712 :     foreach my $If (@{$self->{data}}) {
713 :     my ($I,$f) = @{$If};
714 :     push(@cases,'return '.$f->perl.' if '.$I->perl.'->contains('.$x.');');
715 :     }
716 :     if (defined($self->{otherwise})) {push(@cases,'return '.$self->{otherwise}->perl.';')}
717 :     else {push(@cases,'die "undefined value";')}
718 :     return join("\n",@cases);
719 :     }
720 :    
721 :    
722 :     #
723 :     # Handle the types correctly for error messages and such.
724 :     #
725 :     sub class {"PiecewiseFunction"}
726 :     sub showClass {
727 :     my $self = shift;
728 :     my $f = $self->{data}[0][1]; $f = $self->{otherwise} unless defined $f;
729 :     'a Formula that returns '.Value::showType($f->{tree});
730 :     }
731 :    
732 :     sub type {(shift)->{typeRef}{name}}
733 :     sub typeRef {(shift)->{typeRef}}
734 :    
735 :     #
736 :     # Allow comparison only when the two functions return
737 :     # the same type of result.
738 :     #
739 :     sub typeMatch {
740 :     my $self = shift; my $other = shift; my $ans = shift;
741 :     return $self->type eq $other->type;
742 :     }
743 :    
744 :     ##################################################
745 :     #
746 :     # Overrides the Formula() command so that if
747 :     # the result is a PiecewiseFunction, it is
748 :     # turned into one automatically. Conversely,
749 :     # if a PiecewiseFunction is put into Formula(),
750 :     # this will turn it into a Formula.
751 :     #
752 :     package PiecewiseFunction::Formula;
753 :     our @ISA = ('Value::Formula');
754 :    
755 :     sub new {
756 :     my $self = shift; my $f;
757 :     if (scalar(@_) == 1 && Value::classMatch($_[0],"PiecewiseFunction")) {
758 :     $f = $_[0]->string; $f =~ s/\n/ /g;
759 :     $f = $self->Package("Formula")->new($f);
760 :     } else {
761 :     $f = $self->Package("Formula")->new(@_);
762 :     $f = $f->{tree}->Compute if $f->{tree}{canCompute};
763 :     }
764 :     return $f;
765 :     }
766 :    
767 :     ######################################################################
768 :    
769 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9