[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 5545 - (download) (as text) (annotate)
Sun Sep 30 11:18:39 2007 UTC (12 years, 4 months ago) by dpvc
File size: 25830 byte(s)
Don't use dollar signs in the TeX output, since BEGIN_TEXT/END_TEX
does command substitution then variable substitution then math, so
\{$f->TeX\} would insert dollars, which would then be substituted as
variables.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9