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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5444 - (download) (as text) (annotate)
Wed Aug 29 00:07:47 2007 UTC (12 years, 4 months ago) by dpvc
File size: 24271 byte(s)
Implementation of a PiecewiseFunction class.  Both students and
problem authors can enter peicewise functions, and they will display
nicely in TeX mode.  They can be evaluated, reduced, substituted, and
so on, just like other functions.

There are undoubtedly more features that it needs, but it's a start.

    1 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