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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5952 - (download) (as text) (annotate)
Tue Dec 30 14:05:30 2008 UTC (11 years, 1 month ago) by dpvc
File size: 27034 byte(s)
Combined TeX and string into a common routine since the two were
nearly identical.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/contextInequalities.pl,v 1.19 2008/12/30 08:18:24 dpvc 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 Context("Inequalities"), Context("Inequalities-Only") - Provides contexts that
   20 allow intervals to be specified as inequalities.
   21 
   22 =head1 DESCRIPTION
   23 
   24 Implements contexts that provides for inequalities that produce
   25 the cooresponding Interval, Set or Union MathObjects.  There are
   26 two such contexts:  Context("Inequalities"), in which both
   27 intervals and inequalities are defined, and Context("Inequalities-Only"),
   28 which allows only inequalities as a means of producing intervals.
   29 
   30 =head1 USAGE
   31 
   32   loadMacros("contextInequalities.pl");
   33 
   34   Context("Inequalities");
   35   $S1 = Compute("1 < x <= 4");
   36   $S2 = Inequality("(1,4]");     # force interval to be inequality
   37 
   38   Context("Inequalities-Only");
   39   $S1 = Compute("1 < x <= 4");
   40   $S2 = Inequality("(1,4]");     # generates an error
   41 
   42   $S3 = Compute("x < -2 or x > 2");  # forms a Union
   43   $S4 = Compute("x = 1");            # forms a Set
   44 
   45 You can set the "noneWord" flag to specify the string to
   46 use when the inequalities specify the empty set.  By default,
   47 it is "NONE", but you can change it to other strings.  Be sure
   48 that you use a string that is defined in the Context, however,
   49 if you expect the student to be able to enter it.  For example
   50 
   51   Context("Inequalities");
   52   Context()->constants->add(EmptySet => Set());
   53   Context()->flags->set(noneWord=>"EmptySet");
   54 
   55 creates an empty set as a named constant and uses that name.
   56 
   57 Inequalities and interval notation both can coexist side by
   58 side, but you may wish to convert from one to the other.
   59 Use Inequality() to convert from an Interval, Set or Union
   60 to an Inequality, and use Interval(), Set(), or Union() to
   61 convert from an Inequality object to one in interval notation.
   62 For example:
   63 
   64   $I0 = Compute("(1,2]");            # the interval (1,2]
   65   $I1 = Inequality($I);              # the inequality 1 < x <= 2
   66 
   67   $I0 = Compute("1 < x <= 2");       # the inequality 1 < x <= 2
   68   $I1 = Interval($I0);               # the interval (1,2]
   69 
   70 Note that ineqaulities and inervals can be compared and combined
   71 regardless of the format, so $I0 == $I1 is true in either example
   72 above.
   73 
   74 =cut
   75 
   76 loadMacros("MathObjects.pl");
   77 
   78 sub _contextInequalities_init {Inequalities::Init()}
   79 
   80 package Inequalities;
   81 
   82 #
   83 #  Sets up the two inequality contexts
   84 #
   85 sub Init {
   86   my $context = $main::context{Inequalities} = Parser::Context->getCopy("Interval");
   87   $context->{name} = "Inequalities";
   88   $context->operators->add(
   89      '<'  => {precedence => .5, associativity => 'left', type => 'bin', string => ' < ',
   90               class => 'Inequalities::BOP::inequality', eval => 'evalLessThan', combine => 1},
   91 
   92      '>'  => {precedence => .5, associativity => 'left', type => 'bin', string => ' > ',
   93               class => 'Inequalities::BOP::inequality', eval => 'evalGreaterThan', combine => 1},
   94 
   95      '<=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' <= ', TeX => '\le ',
   96               class => 'Inequalities::BOP::inequality', eval => 'evalLessThanOrEqualTo', combine => 1},
   97 
   98      '>=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' >= ', TeX => '\ge ',
   99               class => 'Inequalities::BOP::inequality', eval => 'evalGreaterThanOrEqualTo', combine => 1},
  100 
  101      '='  => {precedence => .5, associativity => 'left', type => 'bin', string => ' = ',
  102               class => 'Inequalities::BOP::inequality', eval => 'evalEqualTo'},
  103 
  104      '!=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' != ', TeX => '\ne ',
  105               class => 'Inequalities::BOP::inequality', eval => 'evalNotEqualTo'},
  106 
  107      'and' => {precedence => .45, associateivity => 'left', type => 'bin', string => " and ",
  108          TeX => '\hbox{ and }', class => 'Inequalities::BOP::and'},
  109 
  110      'or' => {precedence => .4, associateivity => 'left', type => 'bin', string => " or ",
  111         TeX => '\hbox{ or }', class => 'Inequalities::BOP::or'},
  112   );
  113   $context->operators->set(
  114      '+' => {class => "Inequalities::BOP::add"},
  115      '-' => {class => "Inequalities::BOP::subtract"},
  116   );
  117   $context->parens->set("(" => {type => "List", formInterval => ']'});  # trap these later
  118   $context->parens->set("[" => {type => "List", formInterval => ')'});  # trap these later
  119   $context->strings->remove("NONE");
  120   $context->constants->add(NONE=>Value::Set->new());
  121   $context->flags->set(noneWord => 'NONE', showNotEquals => 1);
  122   $context->{parser}{Variable} = "Inequalities::Variable";
  123   $context->{value}{'Interval()'} = "Inequalities::MakeInterval";
  124   $context->{value}{Inequality} = "Inequalities::Inequality";
  125   $context->{value}{InequalityInterval} = "Inequalities::Interval";
  126   $context->{value}{InequalityUnion} = "Inequalities::Union";
  127   $context->{value}{InequalitySet} = "Inequalities::Set";
  128   $context->{value}{List} = "Inequalities::List";
  129   $context->{precedence}{Inequality} = $context->{precedence}{special};
  130   $context->lists->set(List => {class => 'Inequalities::List::List'});
  131 
  132   #
  133   #  Disable interval notation in "Inequalities-Only" context
  134   #
  135   $context = $main::context{"Inequalities-Only"} = $context->copy;
  136   $context->lists->set(
  137     Interval => {class => 'Inequalities::List::notAllowed'},
  138     Set      => {class => 'Inequalities::List::notAllowed'},
  139     Union    => {class => 'Inequalities::List::notAllowed'},
  140   );
  141   $context->operators->set('U' => {class => 'Inequalities::BOP::union'});
  142   $context->constants->remove('R');
  143 
  144   #
  145   #  Define the Inequality() constructor
  146   #
  147   main::PG_restricted_eval('sub Inequality {Value->Package("Inequality")->new(@_)}');
  148 
  149   return;
  150 }
  151 
  152 
  153 ##################################################
  154 #
  155 #  General BOP that handles the inequalities.
  156 #  The difference comes in the _eval() method,
  157 #  which tells what each computes.
  158 #
  159 package Inequalities::BOP::inequality;
  160 our @ISA = ("Parser::BOP");
  161 
  162 #
  163 #  Check that the inequality is formed between a variable and a number,
  164 #  or between a number and another compatible inequality.  Otherwise,
  165 #  give an error.
  166 #
  167 #  varPos and numPos tell which of lop or rop is the variable and which
  168 #  the number.  varName is the variable involved in the inequality.
  169 #
  170 sub _check {
  171   my $self = shift;
  172   $self->{type} = $Value::Type{interval};
  173   $self->{isInequality} = 1;
  174   ($self->{varPos},$self->{numPos}) =
  175     ($self->{lop}->class eq 'Variable' || $self->{lop}{isInequality} ? ('lop','rop') : ('rop','lop'));
  176   my ($v,$n) = ($self->{$self->{varPos}},$self->{$self->{numPos}});
  177   if (($n->isNumber || $n->{isInfinite}) && ($n->{isConstant} || scalar(keys %{$n->getVariables}) == 0)) {
  178     if ($v->class eq 'Variable') {
  179       $self->{varName} = $v->{name};
  180       delete $self->{equation}{variables}{$v->{name}} if $v->{isNew};
  181       $self->{$self->{varPos}} = Inequalities::DummyVariable->new($self->{equation},$v->{name},$v->{ref});
  182       return;
  183     }
  184     if ($self->{def}{combine} && $v->{isInequality}) {
  185       my $bop = substr($self->{bop},0,1); my $ebop = $bop."=";
  186       if (($v->{bop} eq $bop || $v->{bop} eq $ebop) && $v->{varPos} eq $self->{numPos}) {
  187   $self->{varName} = $v->{varName};
  188   return;
  189       }
  190     }
  191   }
  192   $self->Error("'%s' should have a variable on one side and a number on the other",$self->{bop})
  193     unless $v->{isInequality} && $v->{varPos} eq $self->{numPos};
  194   $self->Error("'%s' can't be combined with '%s'",$v->{bop},$self->{bop});
  195 }
  196 
  197 #
  198 #  Generate the interval for the given type of inequality.
  199 #  If it is a combined inequality, intersect with the other
  200 #  one to get the final set.
  201 #
  202 sub _eval {
  203   my $self = shift; my ($a,$b) = @_;
  204   my $eval = $self->{def}{eval};
  205   my $I = $self->Package("Inequality")->new($self->context,$self->$eval(@_),$self->{varName});
  206   return $I->intersect($a) if Value::isValue($a) && $a->type eq 'Interval';
  207   return $I->intersect($b) if Value::isValue($b) && $b->type eq 'Interval';
  208   return $I;
  209 }
  210 
  211 sub evalLessThan {
  212   my ($self,$a,$b) = @_; my $context = $self->context;
  213   my $I = Value::Infinity->new($context);
  214   return $self->Package("Interval")->new($context,'(',-$I,$b,')') if $self->{varPos} eq 'lop';
  215   return $self->Package("Interval")->new($context,'(',$a,$I,')');
  216 }
  217 
  218 sub evalGreaterThan {
  219   my ($self,$a,$b) = @_; my $context = $self->context;
  220   my $I = Value::Infinity->new;
  221   return $self->Package("Interval")->new($context,'(',$b,$I,')')->with(reversed=>1) if $self->{varPos} eq 'lop';
  222   return $self->Package("Interval")->new($context,'(',-$I,$a,')')->with(reversed=>1);
  223 }
  224 
  225 sub evalLessThanOrEqualTo {
  226   my ($self,$a,$b) = @_; my $context = $self->context;
  227   my $I = Value::Infinity->new;
  228   return $self->Package("Interval")->new($context,'(',-$I,$b,']') if $self->{varPos} eq 'lop';
  229   return $self->Package("Interval")->new($context,'[',$a,$I,')');
  230 }
  231 
  232 sub evalGreaterThanOrEqualTo {
  233   my ($self,$a,$b) = @_; my $context = $self->context;
  234   my $I = Value::Infinity->new;
  235   return $self->Package("Interval")->new($context,'[',$b,$I,')')->with(reversed=>1) if $self->{varPos} eq 'lop';
  236   return $self->Package("Interval")->new($context,'(',-$I,$a,']')->with(reversed=>1);
  237 }
  238 
  239 sub evalEqualTo {
  240   my ($self,$a,$b) = @_; my $context = $self->context;
  241   my $x = ($self->{varPos} eq 'lop' ? $b : $a);
  242   return $self->Package("Set")->new($context,$x);
  243 }
  244 
  245 sub evalNotEqualTo {
  246   my ($self,$a,$b) = @_; my $context = $self->context;
  247   my $x = ($self->{varPos} eq 'lop' ? $b : $a);
  248   my $I = Value::Infinity->new;
  249   return $self->Package("Union")->new($context,
  250             $self->Package("Interval")->new($context,'(',-$I,$x,')'),
  251             $self->Package("Interval")->new($context,'(',$x,$I,')')
  252          )->with(notEqual=>1);
  253 }
  254 
  255 #
  256 #  Inequalities have dummy variables that are not really
  257 #  variables of a formula.
  258 
  259 sub getVariables {{}}
  260 
  261 #
  262 #  Avoid unwanted parentheses from the standard routines.
  263 #
  264 sub string {
  265   my ($self,$precedence) = @_;
  266   my $string; my $bop = $self->{def};
  267 
  268   $string = $self->{lop}->string($bop->{precedence}).
  269             $bop->{string}.
  270             $self->{rop}->string($bop->{precedence});
  271 
  272   return $string;
  273 }
  274 
  275 sub TeX {
  276   my ($self,$precedence) = @_;
  277   my $TeX; my $bop = $self->{def};
  278 
  279   $TeX = $self->{lop}->TeX($bop->{precedence}).
  280          (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string}) .
  281          $self->{rop}->TeX($bop->{precedence});
  282 
  283   return $TeX;
  284 }
  285 
  286 ##################################################
  287 #
  288 #  Implements the "and" operation as set intersection
  289 #
  290 package Inequalities::BOP::and;
  291 our @ISA = ("Parser::BOP");
  292 
  293 sub _check {
  294   my $self = shift;
  295   $self->Error("The operands of '%s' must be inequalities",$self->{bop})
  296     unless $self->{lop}{isInequality} && $self->{rop}{isInequality};
  297   $self->Error("Inequalities combined by '%s' must both use the same variable",$self->{bop})
  298     unless $self->{lop}{varName} eq $self->{rop}{varName};
  299   $self->{type} = Value::Type("Interval",2);
  300   $self->{varName} = $self->{lop}{varName};
  301   $self->{isInequality} = 1;
  302 }
  303 
  304 sub _eval {$_[1]->intersect($_[2])}
  305 
  306 ##################################################
  307 #
  308 #  Implements the "or" operation as set union
  309 #
  310 package Inequalities::BOP::or;
  311 our @ISA = ("Parser::BOP");
  312 
  313 sub _check {
  314   my $self = shift;
  315   $self->Error("The operands of '%s' must be inequalities",$self->{bop})
  316     unless $self->{lop}{isInequality} && $self->{rop}{isInequality};
  317   $self->Error("Inequalities combined by '%s' must both use the same variable",$self->{bop})
  318     unless $self->{lop}{varName} eq $self->{rop}{varName};
  319   $self->{type} = Value::Type("Interval",2);
  320   $self->{varName} = $self->{lop}{varName};
  321   $self->{isInequality} = 1;
  322 }
  323 
  324 sub _eval {$_[1] + $_[2]}
  325 
  326 ##################################################
  327 #
  328 #  Subclass of Parser::Variable that records whether
  329 #  this variable has already been seen in the formula
  330 #  (so that it can be removed from the formula's
  331 #  variable list when used in an inequality.)
  332 #
  333 package Inequalities::Variable;
  334 our @ISA = ("Parser::Variable");
  335 
  336 sub new {
  337   my $self = shift; my $equation = shift; my $name = shift;
  338   my $isNew = !defined $equation->{variables}{$name};
  339   my $n = $self->SUPER::new($equation,$name,@_);
  340   $n->{isNew} = $isNew;
  341   return $n;
  342 }
  343 
  344 ##################################################
  345 #
  346 #  A special class usd for the variables in
  347 #  inequalities, since they are not really
  348 #  variables for the formula.  (They don't need
  349 #  to be subtituted or given values when the
  350 #  formula is evaluated, and so on.)  These are
  351 #  really just placeholders, here.
  352 #
  353 package Inequalities::DummyVariable;
  354 our @ISA = ("Parser::Item");
  355 
  356 sub new {
  357   my $self = shift; my $class = ref($self) || $self;
  358   my ($equation,$name,$ref) = @_;
  359   my $def = $equation->{context}{variables}{$name};
  360   bless {name => $name, ref => $ref, def => $def, equation => $equation}, $class;
  361 }
  362 
  363 sub eval {shift};
  364 
  365 sub string {(shift)->{name}}
  366 
  367 sub TeX {
  368   my $self = shift; my $name = $self->{name};
  369   return $self->{def}{TeX} if defined $self->{def}{TeX};
  370   $name = $1.'_{'.$2.'}' if ($name =~ m/^([^_]+)_?(\d+)$/);
  371   return $name;
  372 }
  373 
  374 sub perl {
  375   my $self = shift;
  376   return $self->{def}{perl} if defined $self->{def}{perl};
  377   return '$'.$self->{name};
  378 }
  379 
  380 ##################################################
  381 #
  382 #  Give an error when U is used.
  383 #
  384 package Inequalities::BOP::union;
  385 our @ISA = ("Parser::BOP::union");
  386 
  387 sub _check {
  388   my $self = shift;
  389   $self->Error("You can't take unions of inequalities")
  390     if $self->{lop}{isInequality} || $self->{rop}{isInequality};
  391   $self->SUPER::_check(@_);
  392   $self->Error("Unions are not allowed in this context");
  393 }
  394 
  395 ##################################################
  396 #
  397 #  Don't allow sums and differences of inequalities
  398 #
  399 package Inequalities::BOP::add;
  400 our @ISA = ("Parser::BOP::add");
  401 
  402 sub _check {
  403   my $self = shift;
  404   $self->SUPER::_check(@_);
  405   $self->Error("Can't add inequalities (do you mean to use 'or'?)")
  406     if $self->{lop}{isInequality} || $self->{rop}{isInequality};
  407 }
  408 
  409 ##################################################
  410 #
  411 #  Don't allow sums and differences of inequalities
  412 #
  413 package Inequalities::BOP::subtract;
  414 our @ISA = ("Parser::BOP::subtract");
  415 
  416 sub _check {
  417   my $self = shift;
  418   $self->SUPER::_check(@_);
  419   $self->Error("Can't subtract inequalities")
  420     if $self->{lop}{isInequality} || $self->{rop}{isInequality};
  421 }
  422 
  423 ##################################################
  424 #
  425 #  For the Inequalities-Only context, report
  426 #  an error for Intervals, Sets or Union notation.
  427 #
  428 package Inequalities::List::notAllowed;
  429 our @ISA = ("Parser::List::List");
  430 
  431 sub _check {(shift)->Error("You are not allowed to use intervals or sets in this context")}
  432 
  433 
  434 ##################################################
  435 ##################################################
  436 #
  437 #  Subclasses of the Interval, Set, and Union classes
  438 #  that stringify as inequalities
  439 #
  440 
  441 #
  442 #  Some common routines to all three classes
  443 #
  444 package Inequalities::common;
  445 
  446 #
  447 #  Turn the object back into its usual Value version
  448 #
  449 sub demote {
  450   my $self = shift;  my $context = $self->context;
  451   my $other = shift; $other = $self unless defined $other;
  452   return $other unless Value::classMatch($other,"Inequality");
  453   $context->Package($other->type)->make($context,$other->makeData);
  454 }
  455 
  456 #
  457 #  Needed to get Interval data in the right order for make(),
  458 #  and demote all the items in a Union
  459 #
  460 sub makeData {(shift)->value}
  461 
  462 #
  463 #  Recursively mark Intervals and Sets in a Union as Inequalities
  464 #
  465 sub updateParts {}
  466 
  467 #
  468 #  Demote the operands to normal Value objects and
  469 #  perform the action, then remake the result into
  470 #  an Inequality again.
  471 #
  472 sub apply {
  473   my $self = shift; my $context = $self->context;
  474   my $method = shift;  my $other = shift;
  475   $context->Package("Inequality")->new($context,
  476     $self->demote->$method($self->demote($other),@_),
  477     $self->{varName});
  478 }
  479 
  480 sub add {(shift)->apply("add",@_)}
  481 sub sub {(shift)->apply("sub",@_)}
  482 sub reduce {(shift)->apply("reduce",@_)}
  483 sub intersect {(shift)->apply("intersect",@_)}
  484 
  485 #
  486 #  The name to use for error messages in answer checkers
  487 #
  488 sub class {"Inequality"}
  489 sub cmp_class {"an Inequality"}
  490 sub showClass {"an Inequality"}
  491 sub typeRef {
  492   my $self = shift;
  493   return Value::Type($self->type, $self->length, $Value::Type{number});
  494 }
  495 
  496 #
  497 #  Get the precedence based on the type rather than the class.
  498 #
  499 sub precedence {
  500   my $self = shift; my $precedence = $self->context->{precedence};
  501   return $precedence->{$self->type}-$precedence->{Interval}+$precedence->{$self->class};
  502 }
  503 
  504 #
  505 #  Produce better error messages for inequalities
  506 #
  507 sub cmp_checkUnionReduce {
  508   my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || '';
  509   if (Value::classMatch($student,"Inequality")) {
  510     return unless $ans->{studentsMustReduceUnions} &&
  511                   $ans->{showUnionReduceWarnings} &&
  512                   !$ans->{isPreview} && !Value::isFormula($student);
  513     my ($result,$error) = $student->isReduced;
  514     return unless $error;
  515     return {
  516       "overlaps" => "Your$nth answer contains overlapping inequalities",
  517       "overlaps in sets" => "Your$nth answer contains equalities that are already included elsewhere",
  518       "uncombined intervals" => "Your$nth answer can be simplified by combining some inequalities",
  519       "uncombined sets" => "",          #  shouldn't get this from inequalities
  520       "repeated elements in set" => "Your$nth answer contains repeated values",
  521       "repeated elements" => "Your$nth answer contains repeated values",
  522     }->{$error};
  523   } else {
  524     return unless Value::can($student,"isReduced");
  525     return Value::cmp_checkUnionReduce($self,$student,$ans,$nth,@_)
  526   }
  527 }
  528 
  529 
  530 ##################################################
  531 
  532 package Inequalities::Interval;
  533 our @ISA = ("Inequalities::common", "Value::Interval");
  534 
  535 sub type {"Interval"}
  536 
  537 sub updateParts {
  538   my $self = shift;
  539   $self->{leftInfinite} = 1 if $self->{data}[0]->{isInfinite};
  540   $self->{rightInfinite} = 1 if $self->{data}[1]->{isInfinite};
  541 }
  542 
  543 sub string {
  544   my $self = shift;
  545   my ($a,$b,$open,$close) = $self->value;
  546   my $x = $self->{varName} || ($self->context->variables->names)[0];
  547   $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
  548   if ($self->{leftInfinite}) {
  549     return "-infinity < $x < infinity" if $self->{rightInfinite};
  550     return $b->string . ($close eq ')' ? ' > ' : ' >= ') . $x if $self->{reversed};
  551     return $x . ($close eq ')' ? ' < ' : ' <= ') . $b->string;
  552   } elsif ($self->{rightInfinite}) {
  553     return $x . ($open eq '(' ? ' > ' : ' >= ') . $a->string if $self->{reversed};
  554     return $a->string . ($open eq '(' ? ' < ' : ' <= ') . $x;
  555   } else {
  556     return $a->string . ($open  eq '(' ? ' < ' : ' <= ') .
  557                    $x . ($close eq ')' ? ' < ' : ' <= ') . $b->string;
  558   }
  559 }
  560 
  561 sub TeX {
  562   my $self = shift;
  563   my ($a,$b,$open,$close) = $self->value;
  564   my $context = $self->context;
  565   my $x = $self->{varName} || ($context->variables->names)[0];
  566   $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
  567   $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
  568   if ($self->{leftInfinite}) {
  569     return "-\\infty < $x < \\infty" if $self->{rightInfinite};
  570     return $b->TeX . ($close eq ')' ? ' > ' : ' \ge ') . $x if $self->{reversed};
  571     return $x . ($close eq ')' ? ' < ' : ' \le ') . $b->TeX;
  572   } elsif ($self->{rightInfinite}) {
  573     return $x . ($open eq '(' ? ' > ' : ' \ge ') . $a->TeX if $self->{reversed};
  574     return $a->TeX . ($open eq '(' ? ' < ' : ' \le ') . $x;
  575   } else {
  576     return $a->TeX . ($open  eq '(' ? ' < ' : ' \le ') .
  577                 $x . ($close eq ')' ? ' < ' : ' \le ') . $b->TeX;
  578   }
  579 }
  580 
  581 ##################################################
  582 
  583 package Inequalities::Union;
  584 our @ISA = ("Inequalities::common", "Value::Union");
  585 
  586 sub type {"Union"}
  587 
  588 #
  589 #  Mark all the parts of the union as inequalities
  590 #
  591 sub updateParts {
  592   my $self = shift;
  593   foreach my $I (@{$self->{data}}) {
  594     $I->{varName} = $self->{varName};
  595     $I->{reduceSets} = $I->{"is".$I->type} = 1;
  596     bless $I, $self->Package("Inequality".$I->type);
  597     $I->updateParts;
  598   }
  599 }
  600 
  601 #
  602 #  Update the intervals and sets when a new union is made
  603 #
  604 sub make {
  605   my $self = (shift)->SUPER::make(@_);
  606   $self->updateParts;
  607   return $self;
  608 }
  609 
  610 #
  611 #  Demote all the items in the union
  612 #
  613 sub makeData {
  614   my $self = shift; my @U = ();
  615   foreach my $I (@{$self->{data}}) {push(@U,$I->demote)}
  616   return @U;
  617 }
  618 
  619 sub string {
  620   my $self = shift;
  621   my $equation = shift; shift; shift; my $prec = shift;
  622   return $self->display("string",$equation,$prec);
  623 }
  624 
  625 sub TeX {
  626   my $self = shift;
  627   my $equation = shift; shift; shift; my $prec = shift;
  628   return $self->display("TeX",$equation,$prec);
  629 }
  630 
  631 sub display {
  632   my $self = shift; my $method = shift; my $equation = shift; my $prec = shift;
  633   my $context = ($equation->{context} || $self->context);
  634   my $X = $self->{varName} || ($context->variables->names)[0];
  635   $X = $context->{variables}{$X}{$method} if defined $context->{variables}{$X}{$method};
  636   $X =~ s/^([^_]+)_?(\d+)$/$1_{$2}/ if $method eq 'TeX';
  637   my $op = $context->{operators}{'or'};
  638   my ($and,$or,$le,$ge,$ne,$open,$close) = @{{
  639     string => [' and ',$op->{string} || ' or ',' <= ',' >= ',' != ','(',')'],
  640     TeX =>    ['\hbox{ and }',$op->{TeX} || $op->{string} || '\hbox{ or }',
  641                ' \le ',' \ge ',' \ne ','\left(','\right)'],
  642   }->{$method}};
  643   my $showNE = $self->getFlag("showNotEquals",1);
  644   my @intervals = (); my @points = (); my $interval;
  645   foreach my $x (@{$self->data}) {
  646     $x->{format} = $self->{format} if defined $self->{format};
  647     if ($x->type eq 'Interval' && $showNE) {
  648       if (defined($interval)) {
  649   if ($interval->{data}[1] == $x->{data}[0]) {
  650     push(@points,$X.$ne.$x->{data}[0]->$method($equation));
  651     $interval = $interval->with(isCopy=>1, data=>[$interval->value]) unless $interval->{isCopy};
  652     $interval->{data}[1] = $x->{data}[1];
  653     $interval->{rightInfinite} = 1 if $x->{rightInfinite};
  654     next;
  655   }
  656   push(@intervals,$self->joinAnd($interval,$method,$and,$equation,@points));
  657       }
  658       $interval = $x; @points = (); next;
  659     }
  660     if (defined($interval)) {
  661       push(@intervals,$self->joinAnd($interval,$method,$and,$equation,@points));
  662       $interval = undef; @points = ();
  663     }
  664     push(@intervals,$x->$method($equation));
  665   }
  666   push(@intervals,$self->joinAnd($interval,$method,$and,$equation,@points)) if defined($interval);
  667   my $string = join($or,@intervals);
  668   $string = $open.$string.$close if defined($prec) && $prec > ($op->{precedence} || 1.5);
  669   return $string;
  670 }
  671 
  672 sub joinAnd {
  673   my $self = shift; $interval = shift; $method = shift, my $and = shift; my $equation = shift;
  674   unshift(@_,$interval->$method($equation)) unless $interval->{leftInfinite} && $interval->{rightInfinite};
  675   return join($and, @_);
  676 }
  677 
  678 ##################################################
  679 
  680 package Inequalities::Set;
  681 our @ISA = ("Inequalities::common", "Value::Set");
  682 
  683 sub type {"Set"}
  684 
  685 sub string {
  686   my $self = shift;  my $equation = shift;
  687   my $x = $self->{varName} || ($self->context->variables->names)[0];
  688   $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
  689   my @coords = ();
  690   foreach my $a (@{$self->data}) {
  691     if (Value::isValue($a)) {
  692       $a->{format} = $self->{format} if defined $self->{format};
  693       push(@coords,$x.' = '.$a->string($equation));
  694     } else {
  695       push(@coords,$x.' = '.$a);
  696     }
  697   }
  698   return $self->getFlag('noneWord') unless scalar(@coords);
  699   return join(" or ",@coords);
  700 }
  701 
  702 sub TeX {
  703   my $self = shift;  my $equation = shift;
  704   my $x = $self->{varName} || ($self->context->variables->names)[0];
  705   $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
  706   $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
  707   my @coords = ();
  708   foreach my $a (@{$self->data}) {
  709     if (Value::isValue($a)) {
  710       $a->{format} = $self->{format} if defined $self->{format};
  711       push(@coords,$x.' = '.$a->TeX($equation));
  712     } else {
  713       push(@coords,$x.' = '.$a);
  714     }
  715   }
  716   return '\hbox{'.$self->getFlag('noneWord').'}' unless scalar(@coords);
  717   return join('\hbox{ or }',@coords);
  718 }
  719 
  720 ##################################################
  721 #
  722 #  A class for making inequalities by hand
  723 #
  724 package Inequalities::Inequality;
  725 our @ISA = ('Value');
  726 
  727 sub new {
  728   my $self = shift; my $class = ref($self) || $self;
  729   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  730   my $S = shift; my $x = shift;
  731   $S = Value::makeValue($S,context=>$context);
  732   if (Value::classMatch($S,"Inequality")) {
  733     if (defined($x)) {$S->{varName} = $x; $S->updateParts}
  734     return $S;
  735   }
  736   $x = ($context->variables->names)[0] unless $x;
  737   $S = bless $S->inContext($context), $context->Package("Inequality".$S->type);
  738   $S->{varName} = $x; $S->{reduceSets} = $S->{"is".$S->Type} = 1;
  739   $S->updateParts;
  740   return $S;
  741 }
  742 
  743 ##################################################
  744 #
  745 #  Allow Interval() to coerce types to Value::Interval
  746 #
  747 package Inequalities::MakeInterval;
  748 our @ISA = ("Value::Interval");
  749 
  750 sub new {
  751   my $self = shift;
  752   $self = $self->SUPER::new(@_);
  753   $self = $self->demote if $self->classMatch("Inequality");
  754   return $self;
  755 }
  756 
  757 ##################################################
  758 #
  759 #  Mark this as a list of inequalities (if it is)
  760 #
  761 package Inequalities::List;
  762 our @ISA = ("Value::List");
  763 
  764 sub new {
  765   my $self = (shift)->SUPER::new(@_);
  766   return $self unless $self->{type} =~ m/^(unknown|Interval|Set|Union)$/;
  767   foreach my $x (@{$self->{data}}) {return $self unless Value::classMatch($x,'Inequality')}
  768   $self->{type} = 'Inequality';
  769   return $self;
  770 }
  771 
  772 package Inequalities::List::List;
  773 our @ISA = ("Parser::List::List");
  774 
  775 sub _check {
  776   my $self = shift; $self->SUPER::_check(@_);
  777   if ($self->canBeInUnion) {
  778     #
  779     #  Convert lists that look like intervals into intervals
  780     #  and then check if they are OK.
  781     #
  782     bless $self, $self->context->{lists}{Interval}{class};
  783     $self->{type} = $Value::Type{interval};
  784     $self->{parens} = $self->context->{parens}{interval};
  785     $self->_check;
  786   } else {
  787     my $entryType = $self->typeRef->{entryType};
  788     return unless $entryType->{name} =~ m/^(unknown|Interval|Set|Union)$/;
  789     foreach my $x (@{$self->{coords}}) {return unless $x->{isInequality}};
  790     $entryType->{name} = "Inequality";
  791   }
  792 }
  793 
  794 ##################################################
  795 
  796 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9