[system] / trunk / pg / macros / contextPiecewiseFunction.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /trunk/pg/macros/contextPiecewiseFunction.pl

Thu Jun 25 23:28:44 2009 UTC (10 years, 7 months ago) by gage
File size: 26879 byte(s)
syncing pg HEAD with pg2.4.7 on 6/25/2009


    1 ################################################################################
2 # WeBWorK Online Homework Delivery System
4 # $CVSHeader$
5 #
6 # This program is free software; you can redistribute it and/or modify it under
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
18
19 contextPiecewiseFunction.pl - Allow usage of piecewise functions.
20
22
23 This file implements a context in which piecewise-defined functions
24 can be specified by students and problem authors.  To use it, add
25
27
28 and then use
29
30   Context("PiecewiseFunction");
31
32 to select the context for piecewise functions.  There are several
33 ways to produce a piecewise function.  For example:
34
35   $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 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 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 If $f(x)=f$ then $$f(a)$$ = \{ans_rule(20)\}. 68 END_TEXT 69 Context()->normalStrings; 70 71 ANS($f->eval(x=>$a)->cmp); 72 73 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 =cut 87 88 loadMacros("MathObjects.pl"); 89 loadMacros("contextInequalities.pl"); 90 91 sub _contextPiecewiseFunction_init {PiecewiseFunction::Init()} 92 93 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 #  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 #
552 sub substitute {
553   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   foreach my $If (@{$self->{data}}) {
565     my ($I,$f) = @{$If}; 566$I = $I->copy; if ($x ne $I->{varName}) {$I->{varName} = $x;$I->updateParts}
567     push(@cases,$I =>$f->substitute(@_));
568   }
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 # 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 #  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 # Check that the function domains have the same number of 676 # 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 my ($a,$b) =$D->value; $a =$a->value; $b =$b->value;
716   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   my $period = ($self->{final_period} ? "." : "");
758   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 join(" else\n",@cases) .$period;
764 }
765
766 #
767 #  TeXify using a "cases" LaTeX environment.
768 #
769 sub TeX {
770   my $self = shift; my @cases = (); 771 my$period = ($self->{final_period} ? "." : ""); 772 foreach my$If (@{$self->{data}}) { 773 my ($I,$f) = @{$If};
774     push(@cases,'\displaystyle{'.$f->TeX."}&\\text{if}\\ ".$I->TeX);
775   }
776   if (scalar(@cases)) {
777     push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{otherwise}') if defined$self->{otherwise};
778     return '\begin{cases}'.join('\cr'."\n",@cases).$period.'\end{cases}'; 779 } 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;