[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 5707 - (download) (as text) (annotate)
Fri Jun 20 14:40:35 2008 UTC (11 years, 7 months ago) by gage
File size: 26490 byte(s)
An experimental collection of macros designed as a first attempt
to make writing sequential problems easier (Davide Cervone principal author)
The rules for using these macros may well change as we gain experience writing
sequential problems.  (See also PGsequentialmacros.pl for some additional, lower level tools.)

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/contextPiecewiseFunction.pl,v 1.8 2008/05/05 16:42:17 gage Exp $
    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   Suppose \(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 =cut
   74 
   75 loadMacros("MathObjects.pl");
   76 loadMacros("contextInequalities.pl");
   77 
   78 sub _contextPiecewiseFunction_init {PiecewiseFunction::Init()}
   79 
   80 package PiecewiseFunction;
   81 
   82 #
   83 #  Create the needed context and the constructor function
   84 #
   85 sub Init {
   86   my $context = $main::context{PiecewiseFunction} = Parser::Context->getCopy("Inequalities");
   87   $context->{value}{PiecewiseFunction} = 'PiecewiseFunction::Function';
   88   $context->operators->add(
   89      "if " => {
   90         precedence =>.31, associativity => 'left', type => 'binary',
   91         string => ' if ', TeX => '\hbox{ if }', class => 'PiecewiseFunction::BOP::if',
   92      },
   93 
   94      "for " => {
   95         precedence =>.31, associativity => 'left', type => 'binary',
   96         string => ' for ', TeX => '\hbox{ for }', class => 'PiecewiseFunction::BOP::if',
   97      },
   98 
   99      "else" => {
  100         precedence =>.3, associativity => 'right', type => 'binary',
  101         string => " else\n", TeX => '\hbox{ else }', class => 'PiecewiseFunction::BOP::else',
  102      },
  103 
  104      "in " => {
  105         precedence => .35, asscoiativity => 'right', type => 'binary',
  106         string => ' in ', TeX => '\in ', class => 'PiecewiseFunction::BOP::in',
  107      },
  108   );
  109   $context->{value}{InequalityIn} = 'PiecewiseFunction::Interval';
  110   $context->{value}{'Formula()'} = 'PiecewiseFunction::Formula';
  111   $context->{cmpDefaults}{PiecewiseFunction} = {reduceSets => 1, requireParenMatch => 1};
  112 
  113   main::PG_restricted_eval('sub PiecewiseFunction {Value->Package("PiecewiseFunction")->new(@_)}');
  114 }
  115 
  116 ##################################################
  117 ##################################################
  118 
  119 #
  120 #  A class to implement undefined values (points that
  121 #  are not in the domain of the function)
  122 #
  123 package PiecewiseFunction::undefined;
  124 our @ISA = ('Value');
  125 
  126 sub new {
  127   my $self = shift; my $class = ref($self) || $self;
  128   my $equation = shift;
  129   bless {data => [], isUndefined => 1, equation => $equation}, $class;
  130 }
  131 
  132 sub value {undef}
  133 
  134 sub string {die "undefined value"}
  135 sub TeX    {die "undefined value"}
  136 sub perl   {"PiecewiseFunction::undefined->new()"}
  137 
  138 ##################################################
  139 #
  140 #  Implement the "if" operator to specify a branch
  141 #  of the piecewise function.
  142 #
  143 package PiecewiseFunction::BOP::if;
  144 our @ISA = ('Parser::BOP');
  145 
  146 #
  147 #  Only allow inequalities on the right.
  148 #  Mark the object with identifying values
  149 #
  150 sub _check {
  151   my $self = shift;
  152   $self->Error("The condition should be an inequality") unless $self->{rop}{isInequality};
  153   $self->{type} = {%{$self->{lop}->typeRef}};
  154   $self->{isIf} = $self->{canCompute} = 1;
  155   $self->{varName} = $self->{rop}{varName} || ($self->context->variables->names)[0];
  156 }
  157 
  158 #
  159 #  Return the function's value if the variable is within
  160 #    the inequality for this branch (otherwise return
  161 #    and undefined value).
  162 #
  163 sub eval {
  164   my $self = shift;
  165   my $I = $self->{rop}->eval;
  166   return PiecewiseFunction::undefined->new unless $I->contains($self->{equation}{values}{$self->{varName}});
  167   return $self->{lop}->eval;
  168 }
  169 
  170 #
  171 #  Make a piecewise function from this branch
  172 #
  173 sub Compute {
  174   my $self = shift; my $context = shift || $self->context; my $method = shift || "new";
  175   return $context->Package("PiecewiseFunction")->$method($context,$self->flatten($context));
  176 }
  177 
  178 #
  179 #  Make an interval=>formula pair from this item
  180 #
  181 sub flatten {
  182   my $self = shift; my $context = shift || $self->context;
  183   my $I = $self->{rop}->eval;
  184   my $f = $context->Package("Formula")->new($context,$self->{lop});
  185   return ($I => $f);
  186 }
  187 
  188 #
  189 #  Print using the TeX method of the PiecewiseFunction object
  190 #
  191 sub TeX {(shift)->Compute(undef,"make")->TeX}
  192 
  193 #
  194 #  Make an if-then-else statement that returns the function's
  195 #    value or an undefined value (depending on whether the
  196 #    variable is in the interval or not).
  197 #
  198 sub perl {
  199   my $self = shift; my $parens = shift;
  200   my $I = $self->{rop}->eval; my $x = "\$".$self->{varName};
  201   my $condition = $I->perl.'->contains('.$x.')';
  202   my $lop = $self->{lop}->perl; my $rop = 'PiecewiseFunction::undefined->new';
  203   return '('.$condition.' ? '.$lop.' : '.$rop.')'
  204 }
  205 
  206 ##################################################
  207 #
  208 #  Implement the "else" operator to join the
  209 #  different branches of the function.
  210 #
  211 package PiecewiseFunction::BOP::else;
  212 our @ISA = ('Parser::BOP');
  213 
  214 #
  215 #  Make sure there is an "if" that goes with this else.
  216 #
  217 sub _check {
  218   my $self = shift;
  219   $self->Error("You must have an 'if' to the left of 'else'") unless $self->{lop}{isIf};
  220   $self->{type} = {%{$self->{lop}->typeRef}};
  221   $self->{isElse} = $self->{canCompute} = 1;
  222 }
  223 
  224 #
  225 #  Use the result of the "if" to decide which value to return.
  226 #
  227 sub eval {
  228   my $self = shift; my $lop = $self->{lop}->eval;
  229   return (ref($lop) eq 'PiecewiseFunction::undefined' ? $self->{rop}->eval : $lop);
  230 }
  231 
  232 #
  233 #  Make a PiecewiseFunction from the (nested) if-then-else values.
  234 #
  235 sub Compute {
  236   my $self = shift; my $context = shift || $self->context; my $method = shift || "new";
  237   return $context->Package("PiecewiseFunction")->$method($context,$self->flatten($context))
  238 }
  239 
  240 #
  241 #  Recursively flatten the if-then-else tree to a list
  242 #  of interval=>formula pairs.
  243 #
  244 sub flatten {
  245   my $self = shift; my $context = shift || $self->context;
  246   my $flatten = $self->{rop}->can("flatten");
  247   return ($self->{lop}->flatten($context),&$flatten($self->{rop},$context)) if $flatten;
  248   my $f = $context->Package("Formula")->new($context,$self->{rop});
  249   return ($self->{lop}->flatten($context),$f);
  250 }
  251 
  252 #
  253 #  Don't do extra parens for nested else's.
  254 #
  255 sub string {
  256   my ($self,$precedence,$showparens,$position,$outerRight) = @_;
  257   my $string; my $bop = $self->{def};
  258   $position = '' unless defined($position);
  259   $showparens = '' unless defined($showparens);
  260   my $addparens = defined($precedence) && ($showparens eq 'all' || $precedence > $bop->{precedence});
  261   $outerRight = !$addparens && ($outerRight || $position eq 'right');
  262 
  263   $string = $self->{lop}->string($bop->{precedence},$bop->{leftparens},'left',$outerRight).
  264             $bop->{string}.
  265             $self->{rop}->string($bop->{precedence});
  266 
  267   $string = $self->addParens($string) if $addparens;
  268   return $string;
  269 }
  270 
  271 #
  272 #  Use the PiecewiseFunction TeX method.
  273 #
  274 sub TeX {(shift)->Compute(undef,"make")->TeX}
  275 
  276 #
  277 #  Use an if-then-else to determine the value to use.
  278 #
  279 sub perl {
  280   my $self = shift; my $parens = shift;
  281   my $I = $self->{lop}{rop}->eval; my $x = "\$".$self->{lop}{varName};
  282   my $condition = $I->perl.'->contains('.$x.')';
  283   my $lop = $self->{lop}{lop}->perl; my $rop = $self->{rop}->perl;
  284   return '('.$condition.' ? '.$lop.' : '.$rop.')';
  285 }
  286 
  287 
  288 ##################################################
  289 #
  290 #  Implement an "in" operator for "x in (a,b)" as an
  291 #  alternative to inequality notation.
  292 #
  293 package PiecewiseFunction::BOP::in;
  294 our @ISA = ('Parser::BOP');
  295 
  296 #
  297 #  Make sure the variable is to the left and an interval,
  298 #  set, or union is to the right.
  299 #
  300 sub _check {
  301   my $self = shift;
  302   $self->{type} = Value::Type("Interval",2);
  303   $self->{isInequality} = 1;
  304   $self->Error("There should be a variable to the left of '%s'",$self->{bop})
  305     unless $self->{lop}->class eq 'Variable';
  306   $self->Error("There should be a set of numbers to the right of '%s'",$self->{bop})
  307     unless $self->{rop}->isSetOfReals;
  308   $self->{varName} = $self->{lop}{name};
  309   delete $self->{equation}{variables}{$self->{lop}{name}} if $self->{lop}{isNew};
  310   $self->{lop} = Inequalities::DummyVariable->new($self->{equation},$self->{lop}{name},$self->{lop}{ref});
  311 }
  312 
  313 #
  314 #  Call this an Inequality so it will be allowed to the
  315 #  right of "if" operators.
  316 #
  317 sub _eval {
  318   my $self = shift;
  319   bless $self->Package("Inequality")->new($_[1],$self->{varName}),
  320     $self->Package("InequalityIn");
  321 }
  322 
  323 ##################################################
  324 #
  325 #  This implements the "in" operator as in inequality.
  326 #  We inherit all the inequality methods, and simply
  327 #  need to handle the string and TeX output.  The
  328 #  underlying type is still an Inerval.
  329 #
  330 package PiecewiseFunction::Interval;
  331 our @ISA = ("Inequalities::Interval");
  332 
  333 sub string {
  334   my $self = shift;  my $equation = shift;
  335   my $x = $self->{varName} || ($self->context->variables->names)[0];
  336   $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
  337   $x . ' in ' . $self->demote->string;
  338 }
  339 
  340 sub TeX {
  341   my $self = shift;  my $equation = shift;
  342   my $x = $self->{varName} || ($self->context->variables->names)[0];
  343   $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
  344   $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
  345   $x . '\in ' . $self->demote->TeX;
  346 }
  347 
  348 ##################################################
  349 ##################################################
  350 #
  351 #  This implements the PiecewiseFunction.  It is an unusual mix
  352 #  of a Value object and a Formula object.  It looks like a
  353 #  Formula for the most part, but doesn't have the same internal
  354 #  structure.  Most of the Formula methods have been provided
  355 #  so that eval, substitute, reduce, etc will be applied to all
  356 #  the branches.
  357 #
  358 package PiecewiseFunction::Function;
  359 our @ISA = ('Value', 'Value::Formula');
  360 
  361 #
  362 #  Create the PiecewiseFunction object, with error reporting
  363 #  for problems in the data.
  364 #
  365 #  Usage:  PiecewiseFunction("formula")
  366 #          PiecewiseFunction(I1 => f1, I2 => f2, ... , fn);
  367 #
  368 #  In the first case, the formula is parsed for "if" and "else" values
  369 #  to produce the function.  In the second, the function is given
  370 #  by interval/formula pairs that associate what function to map over
  371 #  interval.  If there is an unpaired formula at the end, it is
  372 #  the "otherwise" formula that will be used whenever the input
  373 #  does not fall into one of the given intervals.
  374 #
  375 #  Note that the intervals above actually can be Interval, Set,
  376 #  or Union objects, not just plain intervals.
  377 #
  378 sub new {
  379   my $self = shift; my $class = ref($self) || $self;
  380   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  381   Value->Error("You must provide at least one Formula for a Piecewise Function") unless scalar(@_);
  382   my $F = shift; $F = [$F,@_] if scalar(@_);
  383   return $F if ref($F) eq $class;
  384   unless (ref($F) eq 'ARRAY') {
  385     $F = $context->Package("Formula")->new($context,$F);
  386     if ($F->{tree}->can("Compute")) {
  387       $F = $F->{tree}->Compute($context);
  388       return $F if ref($F) eq $class;
  389     }
  390     $F = [$F];
  391   }
  392   my $pf = bless {data => [], context => $context, isPiecewiseFunction => 1}, $class;
  393   my $x = ''; $pf->{variables} = {};
  394   while (scalar(@$F) > 1) {
  395     my $I = shift(@$F); my $f = shift(@$F);
  396     $I = $context->Package("Interval")->new($context,$I) unless Value::classMatch($I,"Interval","Set","Union");
  397     $f = $context->Package("Formula")->new($context,$f) unless Value::isFormula($f);
  398     $I->{equation} = $f->{equation} = $pf; ### Transfer equation flag?
  399     push(@{$pf->{data}},[$I,$f]);
  400     $x = $I->{varName} unless $x;
  401     foreach my $v (keys %{$f->{variables}}) {$pf->{variables}{$v} = 1}
  402   }
  403   if (scalar(@$F)) {
  404     $pf->{otherwise} = $context->Package("Formula")->new($context,shift(@$F));
  405     $pf->{otherwise}{equation} = $pf;  ### transfer?
  406     foreach my $v (keys %{$pf->{otherwise}{variables}}) {$pf->{variables}{$v} = 1}
  407   }
  408   $pf->{varName} = ($x || ($context->variables->names)[0]);
  409   $pf->{variables}{$pf->{varName}} = 1;
  410   $pf->check;
  411   return $pf;
  412 }
  413 
  414 #
  415 #  Create a PiecewiseFunction without error checking (so overlapping intervals,
  416 #  incorrect variables, and so on could appear).
  417 #
  418 sub make {
  419   my $self = shift; my $class = ref($self) || $self;
  420   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  421   my $pf = bless {data => [], context => $context, isPiecewiseFunction => 1}, $class;
  422   my $x = '';
  423   while (scalar(@_) > 1) {
  424     my $I = shift; my $f = shift;
  425     $I->{equation} = $f->{equation} = $pf;  ### Transfer equation flag?
  426     $x = $I->{varName} unless $x;
  427     push(@{$pf->{data}},[$I,$f]);
  428     $self->{typeRef} = $f->typeRef unless defined $self->{typeRef};
  429     foreach my $v (keys %{$f->{variables}}) {$pf->{variables}{$v} = 1}
  430   }
  431   if (scalar(@_)) {
  432     $pf->{otherwise} = shift;
  433     $pf->{otherwise}{equation} = $pf;  ### transfer?
  434     foreach my $v (keys %{$f->{otherwise}{variables}}) {$pf->{variables}{$v} = 1}
  435   }
  436   $pf->{varName} = ($x || ($context->variables->names)[0]);
  437   $pf->{variables}{$pf->{varName}} = 1;
  438   return $pf;
  439 }
  440 
  441 #
  442 #  Do the consistency checks for the separate branches.
  443 #
  444 sub check {
  445   my $self = shift;
  446   $self->checkVariable;
  447   $self->checkMultipleValued;
  448   $self->checkTypes;
  449 }
  450 
  451 #
  452 #  Check that all the inequalities are for the same variable.
  453 #
  454 sub checkVariable {
  455   my $self = shift; my $context = $self->context;
  456   my $x = $self->{varName};
  457   foreach my $If (@{$self->{data}}) {
  458     my ($I,$f) = @$If;
  459     $I = $If->[0] = $context->Package("Inequality")->new($context,$I,$x)
  460       unless $I->classMatch("Inequality");
  461     Value->Error("All the intervals must use the same variable") if $I->{varName} ne $x;
  462   }
  463 }
  464 
  465 #
  466 #  Check that no domain intervals overlap.
  467 #
  468 sub checkMultipleValued {
  469   my $self = shift;
  470   my @D = $self->domainUnion->sort->value;
  471   foreach my $i (0..scalar(@D)-2) {
  472     my ($I,$J) = @D[$i,$i+1];
  473     Value->Error("A piecewise function can't have overlapping domain intervals")
  474       if $I->intersects($J);
  475   }
  476 }
  477 
  478 #
  479 #  Check that all the branches return the same type of result.
  480 #
  481 sub checkTypes {
  482   my $self = shift;
  483   foreach my $If (@{$self->{data}}) {$self->checkType($If->[1])}
  484   $self->checkType($self->{otherwise}) if defined $self->{otherwise};
  485 }
  486 
  487 sub checkType {
  488   my $self = shift; my $f = shift;
  489   if (defined $self->{typeRef}) {
  490     Value->Error("All the formulas must produce the same type of answer")
  491       unless Parser::Item::typeMatch($self->{typeRef},$f->typeRef);
  492   } else {$self->{typeRef} = $f->typeRef}
  493 }
  494 
  495 #
  496 #  This is always considered a formula.
  497 #
  498 sub isConstant {0}
  499 
  500 #
  501 #  Look through the branches for the one that contains
  502 #  the variable's value, and evaluate it.  If not in
  503 #  any of the intervals, use the "otherwise" value,
  504 #  or die with no value if there isn't one.
  505 #
  506 sub eval {
  507   my $self = shift;
  508   $self->setValues(@_); my $x = $self->{values}{$self->{varName}}; $self->unsetValues;
  509   foreach my $If (@{$self->{data}}) {
  510     my ($I,$f) = @{$If};
  511     return $f->eval(@_) if $I->contains($x);
  512   }
  513   return $self->{otherwise}->eval(@_) if defined $self->{otherwise};
  514   die "undefined value";
  515 }
  516 
  517 #
  518 #  Reduce each branch individually.
  519 #
  520 sub reduce {
  521   my $self = shift; my @cases = ();
  522   foreach my $If (@{$self->{data}}) {
  523     my ($I,$f) = @{$If};
  524     push(@cases,$I->copy => $f->reduce(@_));
  525   }
  526   push(@cases,$self->{otherwise}->reduce(@_)) if defined $self->{otherwise};
  527   return $self->make(@cases);
  528 }
  529 
  530 #
  531 #  Substitute into each branch individually.
  532 #  If the function's variable is substituted, then
  533 #    if it is a constant, find the branch for that value
  534 #    and substitute into that, otherwise if it is
  535 #    just another variable, replace the variable
  536 #    in the inequalities as well as the formulas.
  537 #  Otherwise, just replace in the formulas.
  538 #
  539 sub substitute {
  540   my $self = shift;
  541   my @cases = (); my $x = $self->{varName};
  542   $self->setValues(@_); my $a = $self->{values}{$x}; $self->unsetValues(@_);
  543   if (defined $a) {
  544     if (!Value::isFormula($a)) {
  545       my $f = $self->getFunctionFor($a);
  546       die "undefined value" unless defined $f;
  547       return $f->substitute(@_);
  548     }
  549     $x = $a->{tree}{name} if $a->{tree}->class eq 'Variable';
  550   }
  551   foreach my $If (@{$self->{data}}) {
  552     my ($I,$f) = @{$If};
  553     $I = $I->copy; if ($x ne $I->{varName}) {$I->{varName} = $x; $I->updateParts}
  554     push(@cases,$I => $f->substitute(@_));
  555   }
  556   push(@cases,$self->{otherwise}->substitute(@_)) if defined $self->{otherwise};
  557   return $self->make(@cases);
  558 }
  559 
  560 
  561 #
  562 #  Return the domain of the function (will be (-inf,inf) if
  563 #  there is an "otherwise" formula.
  564 #
  565 sub domain {
  566   my $self = shift;
  567   return $self->domainR if defined $self->{otherwise};
  568   return $self->domainUnion->reduce;
  569 }
  570 
  571 #
  572 #  The set (-inf,inf).
  573 #
  574 sub domainR {
  575   my $self = shift; my $context = $self->context;
  576   my $Infinity = $context->Package("Infinity")->new($context);
  577   return $context->Package("Interval")->make($context,'(',-$Infinity,$Infinity,')');
  578 }
  579 
  580 #
  581 #  The domain formed by the explicitly given intervals
  582 #  (excludes the "otherwise" portion, if any)
  583 #
  584 sub domainUnion {
  585   my $self = shift; my $context = $self->context;
  586   my @cases = (); foreach my $If (@{$self->{data}}) {push(@cases,$If->[0])}
  587   return $context->Package("Union")->make($context,@cases);
  588 }
  589 
  590 #
  591 #  Creates a copy of the PiecewiseFunction where the "otherwise"
  592 #  formula has been given explicit intervals within the object.
  593 #  (This makes it easier to compare two PiecewiseFormulas
  594 #  interval by interval.)
  595 #
  596 sub noOtherwise {
  597   my $self = (shift)->copy; my $context = $self->context;
  598   return $self unless defined $self->{otherwise};
  599   my $otherwise = $self->domainR - $self->domainUnion->reduce;
  600   return $self if $otherwise->isEmpty;
  601   $otherwise = $context->Package("Union")->new($context,$otherwise) unless $otherwise->type eq 'Union';
  602   foreach my $I ($otherwise->value) {
  603     my $D = $context->Package("Inequality")->new($context,$I,$self->{varName});
  604     push(@{$self->{data}},[$D,$self->{otherwise}]);
  605   }
  606   delete $self->{otherwise};
  607   foreach my $If (@{$self->{data}}) {$If->[0]{equation} = $If->[1]{equation} = $self}
  608   return $self;
  609 }
  610 
  611 #
  612 #  Look up the function for the nth branch (or the "otherwise"
  613 #  function if n is omitted or too big or too small).
  614 #
  615 sub getFunction {
  616   my $self = shift; my $n = shift;
  617   return $self->{otherwise} if !defined $n || $n < 1 || $n > $self->length;
  618   return $self->{data}[$n-1][1];
  619 }
  620 
  621 #
  622 #  Look up the domain for the nth branch (or the "otherwise"
  623 #  domain if n is omitted or too big or too small).
  624 #
  625 sub getDomain {
  626   my $self = shift; my $n = shift;
  627   return $self->Package("Inequality")->new($self->context,
  628     $self->domainR - $self->domainUnion,$self->{varName})
  629        if !defined $n || $n < 1 || $n > $self->length;
  630   return $self->{data}[$n-1][0];
  631 }
  632 
  633 #
  634 #  Get the function for the given value of the variable
  635 #  (or undef if there is none).
  636 #
  637 sub getFunctionFor {
  638   my $self = shift; my $x = shift;
  639   foreach my $If (@{$self->{data}}) {
  640     my ($I,$f) = @$If;
  641     return $f if $I->contains($x);
  642   }
  643   return $self->{otherwise};
  644 }
  645 
  646 #
  647 #  Implements the <=> operator (really only handles equality ir not)
  648 #
  649 sub compare {
  650   my ($l,$r,$flag) = @_; my $self = $l;
  651   my $context = $self->context; my $result;
  652   $r = $context->Package("PiecewiseFunction")->new($context,$r) unless Value::classMatch($r,"PiecewiseFunction");
  653   Value::Error("Formulas from different contexts can't be compared")
  654     unless $l->{context} == $r->{context};
  655   $l = $l->noOtherwise; $r = $r->noOtherwise;
  656   $result = $l->compareDomains($r); return $result if $result;
  657   $result = $l->compareFormulas($r); return $result if $result;
  658   return 0;
  659 }
  660 
  661 #
  662 #  Check that the function domains have the same number of
  663 #  components, and that those components agree, interval by interval.
  664 #
  665 sub compareDomains {
  666   my $self = shift; my $other = shift;
  667   my @D0 = $self->domainUnion->sort->value;
  668   my @D1 = $other->domainUnion->sort->value;
  669   return scalar(@D0) <=> scalar(@D1) unless scalar(@D0) == scalar(@D1);
  670   foreach my $i (0..$#D0) {
  671     my $result = ($D0[$i] <=> $D1[$i]);
  672     return $result if $result;
  673   }
  674   return 0;
  675 }
  676 
  677 #
  678 #  Now that the intervals are known to agree, compare
  679 #  the individual functions on each interval.  Do an
  680 #  appropriate check depending on the type of each
  681 #  branch:  Interval, Set, or Union.
  682 #
  683 sub compareFormulas {
  684   my $self = shift; my $other = shift;
  685   my @D0 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $self->value);
  686   my @D1 = main::PGsort(sub {$_[0][0] < $_[1][0]}, $other->value);
  687   foreach my $i (0..$#D0) {
  688     my ($D,$f0,$f1) = (@{$D0[$i]},$D1[$i][1]);
  689     my $method = "compare".$D->type;
  690     my $result = $self->$method($D,$f0,$f1);
  691     return $result if $result;
  692   }
  693   return 0;
  694 }
  695 
  696 #
  697 #  Use the Interval to determine the limits for use
  698 #  in comparing the two functions.
  699 #
  700 sub compareInterval {
  701   my $self = shift; my ($D,$f0,$f1) = @_;
  702   my ($a,$b) = $D->value; $a = $a->value; $b = $b=>value;
  703   return $f0 == $f1 if $D->{leftInfinite} && $D->{rightInfinite};
  704   $a = $b - 2 if $D->{leftInfinite};
  705   $b = $a + 2 if $D->{rightInfinite};
  706   return $f0->with(limits=>[$a,$b]) <=> $f1;
  707 }
  708 
  709 #
  710 #  For a set, check that the functions agree on every point.
  711 #
  712 sub compareSet {
  713   my $self = shift; my ($D,$f0,$f1) = @_;
  714   my $x = $self->{varName};
  715   foreach my $a ($self->value) {
  716     my $result = $f0->eval($x=>$a) <=> $f1->eval($x=>$a);
  717     return $result if $result;
  718   }
  719   return 0;
  720 }
  721 
  722 #
  723 #  For a union, do the appropriate check for
  724 #  each object in the union.
  725 #
  726 sub compareUnion {
  727   my $self = shift; my ($D,$f0,$f1) = @_;
  728   foreach my $S ($self->value) {
  729     my $method = "compare".$S->type;
  730     my $result = $self->$method($D,$f0,$f1);
  731     return $result if $result;
  732   }
  733   return 0;
  734 }
  735 
  736 
  737 #
  738 #  Stringify using newlines at after each "else".
  739 #  (Otherwise the student and correct answer can
  740 #  get unacceptably long.)
  741 #
  742 sub string {
  743   my $self = shift; my @cases = ();
  744   foreach my $If (@{$self->{data}}) {
  745     my ($I,$f) = @{$If};
  746     push(@cases,$f->string." if ".$I->string);
  747   }
  748   push(@cases,$self->{otherwise}->string) if defined $self->{otherwise};
  749   join(" else\n",@cases);
  750 }
  751 
  752 #
  753 #  TeXify using a "cases" LaTeX environment.
  754 #
  755 sub TeX {
  756   my $self = shift; my @cases = ();
  757   foreach my $If (@{$self->{data}}) {
  758     my ($I,$f) = @{$If};
  759     push(@cases,'\displaystyle{'.$f->TeX."}&\\text{if}\\ ".$I->TeX);
  760   }
  761   if (scalar(@cases)) {
  762     push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{otherwise}') if defined $self->{otherwise};
  763     return '\begin{cases}'.join('\cr'."\n",@cases).'\end{cases}';
  764   } else {
  765     return $self->{otherwise}->TeX;
  766   }
  767 }
  768 
  769 #
  770 #  Create a code segment that returns the correct value depending on which
  771 #  interval contains the variable's value (or an undefined value).
  772 #
  773 sub perl {
  774   my $self = shift; my $x = "\$".$self->{varName};
  775   my @cases = ();
  776   foreach my $If (@{$self->{data}}) {
  777     my ($I,$f) = @{$If};
  778     push(@cases,'return '.$f->perl.' if '.$I->perl.'->contains('.$x.');');
  779   }
  780   if (defined($self->{otherwise})) {push(@cases,'return '.$self->{otherwise}->perl.';')}
  781                               else {push(@cases,'die "undefined value";')}
  782   return join("\n",@cases);
  783 }
  784 
  785 
  786 #
  787 #  Handle the types correctly for error messages and such.
  788 #
  789 sub class {"PiecewiseFunction"}
  790 sub showClass {
  791   my $self = shift;
  792   my $f = $self->{data}[0][1]; $f = $self->{otherwise} unless defined $f;
  793   'a Formula that returns '.Value::showType($f->{tree});
  794 }
  795 
  796 sub type {(shift)->{typeRef}{name}}
  797 sub typeRef {(shift)->{typeRef}}
  798 
  799 #
  800 #  Allow comparison only when the two functions return
  801 #  the same type of result.
  802 #
  803 sub typeMatch {
  804   my $self = shift; my $other = shift; my $ans = shift;
  805   return $self->type eq $other->type;
  806 }
  807 
  808 ##################################################
  809 #
  810 #  Overrides the Formula() command so that if
  811 #  the result is a PiecewiseFunction, it is
  812 #  turned into one automatically.  Conversely,
  813 #  if a PiecewiseFunction is put into Formula(),
  814 #  this will turn it into a Formula.
  815 #
  816 package PiecewiseFunction::Formula;
  817 our @ISA = ('Value::Formula');
  818 
  819 sub new {
  820   my $self = shift; my $f;
  821   if (scalar(@_) == 1 && Value::classMatch($_[0],"PiecewiseFunction")) {
  822     $f = $_[0]->string; $f =~ s/\n/ /g;
  823     $f = $self->Package("Formula")->new($f);
  824   } else {
  825     $f = $self->Package("Formula")->new(@_);
  826     $f = $f->{tree}->Compute if $f->{tree}{canCompute};
  827   }
  828   return $f;
  829 }
  830 
  831 ######################################################################
  832 
  833 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9