[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 6058 - (download) (as text) (annotate)
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
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 contextPiecewiseFunction.pl - Allow usage of piecewise functions.
   20 
   21 =head1 DESCRIPTION
   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 
   26   loadMacros("contextPiecewiseFunction.pl");
   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;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9