[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 6058 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9