[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 5551 - (download) (as text) (annotate)
Tue Oct 2 20:48:05 2007 UTC (12 years, 2 months ago) by sh002i
File size: 25601 byte(s)
improved formatting for docs -- these were in pod sections but were all
formatted as verbatim sections, and i moved them into normal paragraphs,
lists, etc. should make things more readable from the web.

    1 =head1 NAME
    2 
    3 contextPiecewiseFunction.pl - Allow usage of piecewise functions.
    4 
    5 =head1 DESCRIPTION
    6 
    7 This file implements a context in which piecewise-defined functions
    8 can be specified by students and problem authors.  To use it, add
    9 
   10     loadMacros("contextPiecewiseFunction.pl");
   11 
   12 and then use
   13 
   14     Context("PiecewiseFuntion");
   15 
   16 to select the context for piecewise functions.  There are several
   17 ways to produce a piecewise function.  For example:
   18 
   19     $f = Compute("x if x >= 0 else -x");
   20     $f = Compute("x if x >= 0 else -x if x < 0");
   21     $f = Formula("x+1 if x > 2 else 4 if x = 2 else 1-x");
   22     $f = PiecewiseFunction("x^2 if 1 < x <= 2 else 2x+1");
   23     $f = PiecewiseFunction("1 < x <= 2" => "x^2", "2x+1");
   24     $f = PiecewiseFunction("(1,2]" => "x^2", "2x+1");
   25     $f = PiecewiseFunction(Interval("(1,2]") => "x^2", "2x+1");
   26 
   27 You can use either Compute() or Formula() interchangeably to
   28 convert a string containing "if" and "else" to the corresponding
   29 PiecewiseFunction.  The PiecewiseFunction() constructor can
   30 also do this, or you can pass it a list of interval=>formula
   31 pairs that specify the various branches.  If there is an
   32 unpaired final formula, it represents the "otherwise" portion
   33 of the function (the formula to use of the input is not in
   34 any of the given intervals).
   35 
   36 Note that you can use Inveral, Set, or Union objects in place of
   37 the intervals in the specification of a piecewise function.
   38 
   39 The PiecewiseFunction object TeXifies using a LaTeX "cases"
   40 environment, so you can use these objects to produce nice
   41 output even if you are not asking a student to enter one.
   42 For example:
   43 
   44     Context("PiecewiseFunction");
   45 
   46     $f = Formula("1-x if x > 0 else 4 if x = 0 else 1+x if x < 0");
   47     $a = random(-2,2,.1);
   48 
   49     Context()->texStrings;
   50     BEGIN_TEXT
   51     Suppose \(f(x)=$f\).  Then \(f($a)\) = \{ans_rule(20)\}.
   52     END_TEXT
   53     Context()->normalStrings;
   54 
   55     ANS($f->eval(x=>$a)->cmp);
   56 
   57 =cut
   58 
   59 loadMacros("MathObjects.pl");
   60 loadMacros("contextInequalities.pl");
   61 
   62 sub _contextPiecewiseFunction_init {PiecewiseFunction::Init()}
   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