[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 5373 - (download) (as text) (annotate)
Sun Aug 19 02:01:57 2007 UTC (12 years, 3 months ago) by dpvc
File size: 16918 byte(s)
Normalized comments and headers to that they will format their POD
documentation properly.  (I know that the POD processing was supposed
to strip off the initial #, but that doesn't seem to happen, so I've
added a space throughout.)

    1 loadMacros("MathObjects.pl");
    2 
    3 sub _contextInequalities_init {Inequalities::Init()}
    4 
    5 =head1 Context("Inequalities"), Context("Inequalities-Only")
    6 
    7  #########################################################################
    8  #
    9  #  Implements contexts that provides for inequalities that produce
   10  #  the cooresponding Interval, Set or Union MathObjects.  There are
   11  #  two such contexts:  Context("Inequalities"), in which both
   12  #  intervals and inequalities are defined, and Context("Inequalities-Only"),
   13  #  which allows only inequalities as a means of producing intervals.
   14  #
   15  #  Usage:    loadMacros("contextInequalities.pl");
   16  #
   17  #            Context("Inequalities");
   18  #            $S1 = Formula("1 < x <= 4");
   19  #            $S2 = Formula("(1,4]");        # either form is OK
   20  #
   21  #            Context("Inequalities-Only");
   22  #            $S1 = Formula("1 < x <= 4");
   23  #            $S2 = Formula("(1,4]");        # generates an error
   24  #
   25  #            $S3 = Formula("x < -2 or x > 2");  # forms a Union
   26  #            $S4 = Formula("x = 1");            # forms a Set
   27  #
   28  #  You can set the "stringifyAsInequalities" flag to 1 to force
   29  #  output from the intervals, sets, and unions created in this
   30  #  context to be output as inequalities rather than their
   31  #  usual Inerval, Set or Union forms.
   32  #
   33  #     Context("Inequalities")->flags->set(stringifyAsInequalities=>1);
   34  #
   35  #  You can also set the "noneWord" flag to specify the string to
   36  #  use when the inequalities specify the empty set.  By default,
   37  #  it is "NONE", but you can change it to other strings.  Be sure
   38  #  that you use a string that is defined in the Context, however,
   39  #  if you expect the student to be able to enter it.  For example
   40  #
   41  #    Context("Inequalities");
   42  #    Context()->constants->add(EmptySet => Set());
   43  #    Context()->flags->set(noneWord=>"EmptySet");
   44  #
   45  #  creates an empty set as a named constant and uses that name.
   46  #
   47 
   48 =cut
   49 
   50 package Inequalities;
   51 
   52 #
   53 #  Sets up the two inequality contexts
   54 #
   55 sub Init {
   56   my $context = $main::context{Inequalities} = Parser::Context->getCopy("Interval");
   57   $context->operators->add(
   58      '<'  => {precedence => .5, associativity => 'left', type => 'bin', string => ' < ',
   59               class => 'Inequalities::BOP::inequality', eval => 'evalLessThan', combine => 1},
   60 
   61      '>'  => {precedence => .5, associativity => 'left', type => 'bin', string => ' > ',
   62               class => 'Inequalities::BOP::inequality', eval => 'evalGreaterThan', combine => 1},
   63 
   64      '<=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' <= ',
   65               class => 'Inequalities::BOP::inequality', eval => 'evalLessThanOrEqualTo', combine => 1},
   66 
   67      '>=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' >= ',
   68               class => 'Inequalities::BOP::inequality', eval => 'evalGreaterThanOrEqualTo', combine => 1},
   69 
   70      '='  => {precedence => .5, associativity => 'left', type => 'bin', string => ' = ',
   71               class => 'Inequalities::BOP::inequality', eval => 'evalEqualTo'},
   72 
   73      '!=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' != ',
   74               class => 'Inequalities::BOP::inequality', eval => 'evalNotEqualTo'},
   75 
   76      'and' => {precedence => .45, associateivity => 'left', type => 'bin', string => " and ",
   77          TeX => '\hbox{ and }', class => 'Inequalities::BOP::and'},
   78 
   79      'or' => {precedence => .4, associateivity => 'left', type => 'bin', string => " or ",
   80         TeX => '\hbox{ or }', class => 'Inequalities::BOP::or'},
   81   );
   82   $context->flags->set(stringifyAsInequalities => 0, noneWord => 'NONE');
   83   $context->strings->remove("NONE");
   84   $context->constants->add(NONE=>Value::Set->new());
   85   $context->{parser}{Variable} = "Inequalities::Variable";
   86   $context->{value}{Interval} = "Inequalities::Interval";
   87   $context->{value}{Union} = "Inequalities::Union";
   88   $context->{value}{Set} = "Inequalities::Set";
   89 
   90   #
   91   #  Disable interval notation in Context("Inequalities-Only");
   92   #
   93   $context = $main::context{"Inequalities-Only"} = $context->copy;
   94   $context->parens->remove('(','[','{');
   95   $context->parens->redefine('(',from=>"Numeric");
   96   $context->parens->redefine('[',from=>"Numeric");
   97   $context->parens->redefine('{',from=>"Numeric");
   98   $context->parens->set(
   99     '(' => {formInterval=>0},
  100     '[' => {formInterval=>0}
  101   );
  102   $context->lists->set(List => {class => 'Inequalities::List::List'});
  103   $context->operators->remove('U');
  104   $context->constants->remove('R');
  105   return;
  106 }
  107 
  108 
  109 ##################################################
  110 #
  111 #  General BOP that handles the inequalities.
  112 #  The difference comes in the _eval() method,
  113 #  which tells what each computes.
  114 #
  115 package Inequalities::BOP::inequality;
  116 our @ISA = ("Parser::BOP");
  117 
  118 #
  119 #  Check that the inequality is formed between a variable and a number,
  120 #  or between a number and another compatable inequality.  Otherwise,
  121 #  give an error.
  122 #
  123 #  varPos and numPos tell which of lop or rop is the variable and which
  124 #  the number.  varName is the variable involved in the inequality.
  125 #
  126 sub _check {
  127   my $self = shift;
  128   $self->{type} = Value::Type("Interval",2);
  129   $self->{isInequality} = 1;
  130   ($self->{varPos},$self->{numPos}) =
  131     ($self->{lop}->class eq 'Variable' || $self->{lop}{isInequality} ? ('lop','rop') : ('rop','lop'));
  132   my ($v,$n) = ($self->{$self->{varPos}},$self->{$self->{numPos}});
  133   if ($n->isNumber && $n->{isConstant}) {
  134     if ($v->class eq 'Variable') {
  135       $self->{varName} = $v->{name};
  136       delete $self->{equation}{variables}{$v->{name}} if $v->{isNew};
  137       $self->{$self->{varPos}} = Inequalities::DummyVariable->new($self->{equation},$v->{name},$v->{ref});
  138       return;
  139     }
  140     if ($self->{def}{combine} && $v->{isInequality}) {
  141       my $bop = substr($self->{bop},0,1); my $ebop = $bop."=";
  142       if (($v->{bop} eq $bop || $v->{bop} eq $ebop) && $v->{varPos} eq $self->{numPos}) {
  143   $self->{varName} = $v->{varName};
  144   return;
  145       }
  146     }
  147   }
  148   $self->Error("'%s' should have a variable on one side and a number on the other",$self->{bop})
  149     unless $v->{isInequality} && $v->{varPos} eq $self->{numPos};
  150   $self->Error("'%s' can't be combined with '%s'",$v->{bop},$self->{bop});
  151 }
  152 
  153 #
  154 #  Generate the interval for the given type of inequality.
  155 #  If it is a combined inequality, intersect with the other
  156 #  one to get the final set.
  157 #
  158 sub _eval {
  159   my $self = shift; my ($a,$b) = @_;
  160   my $eval = $self->{def}{eval};
  161   my $I = $self->$eval(@_);
  162   return $I->intersect($a) if Value::isValue($a) && $a->type eq 'Interval';
  163   return $I->intersect($b) if Value::isValue($b) && $b->type eq 'Interval';
  164   return $I;
  165 }
  166 
  167 sub evalLessThan {
  168   my ($self,$a,$b) = @_; my $context = $self->context;
  169   my $I = Value::Infinity->new($context);
  170   return $self->Package("Interval")->new($context,'(',-$I,$b,')') if $self->{varPos} eq 'lop';
  171   return $self->Package("Interval")->new($context,'(',$a,$I,')');
  172 }
  173 
  174 sub evalGreaterThan {
  175   my ($self,$a,$b) = @_; my $context = $self->context;
  176   my $I = Value::Infinity->new;
  177   return $self->Package("Interval")->new($context,'(',$b,$I,')') if $self->{varPos} eq 'lop';
  178   return $self->Package("Interval")->new($context,'(',-$I,$a,')');
  179 }
  180 
  181 sub evalLessThanOrEqualTo {
  182   my ($self,$a,$b) = @_; my $context = $self->context;
  183   my $I = Value::Infinity->new;
  184   return $self->Package("Interval")->new($context,'(',-$I,$b,']') if $self->{varPos} eq 'lop';
  185   return $self->Package("Interval")->new($context,'[',$a,$I,')');
  186 }
  187 
  188 sub evalGreaterThanOrEqualTo {
  189   my ($self,$a,$b) = @_; my $context = $self->context;
  190   my $I = Value::Infinity->new;
  191   return $self->Package("Interval")->new($context,'[',$b,$I,')') if $self->{varPos} eq 'lop';
  192   return $self->Package("Interval")->new($context,'(',-$I,$a,']');
  193 }
  194 
  195 sub evalEqualTo {
  196   my ($self,$a,$b) = @_; my $context = $self->context;
  197   my $x = ($self->{varPos} eq 'lop' ? $b : $a);
  198   return $self->Package("Set")->new($context,$x);
  199 }
  200 
  201 sub evalNotEqualTo {
  202   my ($self,$a,$b) = @_; my $context = $self->context;
  203   my $x = ($self->{varPos} eq 'lop' ? $b : $a);
  204   my $I = Value::Infinity->new;
  205   return $self->Package("Union")->new($context,
  206             $self->Package("Interval")->new($context,'(',-$I,$x,')'),
  207             $self->Package("Interval")->new($context,'(',$x,$I,')')
  208          );
  209 }
  210 
  211 #
  212 #  Inequalities have dummy variables that are not really
  213 #  variables of a formula.
  214 
  215 sub getVariables {{}}
  216 
  217 #
  218 #  Avoid unwanted parentheses from the standard routines.
  219 #
  220 sub string {
  221   my ($self,$precedence) = @_;
  222   my $string; my $bop = $self->{def};
  223 
  224   $string = $self->{lop}->string($bop->{precedence}).
  225             $bop->{string}.
  226             $self->{rop}->string($bop->{precedence});
  227 
  228   return $string;
  229 }
  230 
  231 sub TeX {
  232   my ($self,$precedence) = @_;
  233   my $TeX; my $bop = $self->{def};
  234 
  235   $TeX = $self->{lop}->TeX($bop->{precedence}).
  236          (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string}) .
  237          $self->{rop}->TeX($bop->{precedence});
  238 
  239   return $TeX;
  240 }
  241 
  242 ##################################################
  243 #
  244 #  Implements the "and" operation as set intersection
  245 #
  246 package Inequalities::BOP::and;
  247 our @ISA = ("Parser::BOP");
  248 
  249 sub _check {
  250   my $self = shift;
  251   $self->Error("The operands of '%s' must be Intervals, Sets or Unions")
  252     unless $self->{lop}->isSetOfReals && $self->{rop}->isSetOfReals;
  253   $self->{type} = Value::Type("Interval",2);
  254   $self->{varName} = $self->{lop}{varName} || $self->{rop}{varName};
  255 }
  256 
  257 sub _eval {$_[1]->intersect($_[2])}
  258 
  259 ##################################################
  260 #
  261 #  Implements the "or" operation as set union
  262 #
  263 package Inequalities::BOP::or;
  264 our @ISA = ("Parser::BOP");
  265 
  266 sub _check {
  267   my $self = shift;
  268   $self->Error("The operands of '%s' must be Intervals, Sets or Unions")
  269     unless $self->{lop}->isSetOfReals && $self->{rop}->isSetOfReals;
  270   $self->{type} = Value::Type("Interval",2);
  271   $self->{varName} = $self->{lop}{varName} || $self->{rop}{varName};
  272 }
  273 
  274 sub _eval {$_[1] + $_[2]}
  275 
  276 ##################################################
  277 #
  278 #  Subclass of Parser::Variable that records whether
  279 #  this variable has already been seen in the formula
  280 #  (so that it can be removed from the formula's
  281 #  variable list when used in an inequality.)
  282 #
  283 package Inequalities::Variable;
  284 our @ISA = ("Parser::Variable");
  285 
  286 sub new {
  287   my $self = shift; my $equation = shift; my $name = shift;
  288   my $isNew = !defined $equation->{variables}{$name};
  289   my $n = $self->SUPER::new($equation,$name,@_);
  290   $n->{isNew} = $isNew;
  291   return $n;
  292 }
  293 
  294 ##################################################
  295 #
  296 #  A special class usd for the variables in
  297 #  inequalities, since they are not really
  298 #  variables for the formula.  (They don't need
  299 #  to be subtituted or given values when the
  300 #  formula is evaluated, and so on.)  These are
  301 #  really just placeholders, here.
  302 #
  303 package Inequalities::DummyVariable;
  304 our @ISA = ("Parser::Item");
  305 
  306 sub new {
  307   my $self = shift; my $class = ref($self) || $self;
  308   my ($equation,$name,$ref) = @_;
  309   my $def = $equation->{context}{variables}{$name};
  310   bless {name => $name, ref => $ref, def => $def, equation => $equation}, $class;
  311 }
  312 
  313 sub eval {shift};
  314 
  315 sub string {(shift)->{name}}
  316 
  317 sub TeX {
  318   my $self = shift; my $name = $self->{name};
  319   return $self->{def}{TeX} if defined $self->{def}{TeX};
  320   $name = $1.'_{'.$2.'}' if ($name =~ m/^([^_]+)_?(\d+)$/);
  321   return $name;
  322 }
  323 
  324 sub perl {
  325   my $self = shift;
  326   return $self->{def}{perl} if defined $self->{def}{perl};
  327   return '$'.$self->{name};
  328 }
  329 
  330 ##################################################
  331 #
  332 #  For the Inequalities-Only context, we make lists
  333 #  that report errors, so that students MUST produce
  334 #  their intervals via inequalities.
  335 #
  336 package Inequalities::List::List;
  337 our @ISA = ("Parser::List::List");
  338 
  339 sub _check {
  340   my $self = shift;
  341   $self->SUPER::_check(@_);
  342   $self->Error("You are not allowed to use intervals in this context") if $self->{open};
  343 }
  344 
  345 ##################################################
  346 #
  347 #  Override the string and TeX methods
  348 #  so that we can strinfigy as inequalities
  349 #  rather than intervals.
  350 #
  351 package Inequalities::Interval;
  352 our @ISA = ("Value::Interval");
  353 
  354 sub new {
  355   my $self = shift; $self = $self->SUPER::new(@_);
  356   $self->{isValue} = 1;
  357   return $self;
  358 }
  359 
  360 sub make {
  361   my $self = shift; $self = $self->SUPER::make(@_);
  362   $self->{isValue} = 1;
  363   return $self;
  364 }
  365 
  366 sub string {
  367   my $self = shift;
  368   return $self->SUPER::string(@_) unless $self->getFlag('stringifyAsInequalities');
  369   my ($a,$b,$open,$close) = $self->value;
  370   my $x = ($self->context->variables->names)[0];
  371   $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
  372   my $left  = ($open  eq '(' ? ' < ' : ' <= ');
  373   my $right = ($close eq ')' ? ' < ' : ' <= ');
  374   my $inequality = "";
  375   $inequality .= $a->string.$left unless $self->{leftInfinite};
  376   $inequality .= $x;
  377   $inequality .= $right.$b->string unless $self->{rightInfinite};
  378   $inequality = "-infinity < $x < infinity" if $inequality eq $x;
  379   return $inequality;
  380 }
  381 
  382 sub TeX {
  383   my $self = shift;
  384   return $self->SUPER::TeX(@_) unless $self->getFlag('stringifyAsInequalities');
  385   my ($a,$b,$open,$close) = $self->value;
  386   my $context = $self->context;
  387   my $x = ($context->variables->names)[0];
  388   $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
  389   $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
  390   my $left  = ($open  eq '(' ? ' < ' : ' <= ');
  391   my $right = ($close eq ')' ? ' < ' : ' <= ');
  392   my $inequality = "";
  393   $inequality .= $a->string.$left unless $self->{leftInfinite};
  394   $inequality .= $x;
  395   $inequality .= $right.$b->string unless $self->{rightInfinite};
  396   $inequality = "-\\infty < $x < \\infty " if $inequality eq $x;
  397   return $inequality;
  398 }
  399 
  400 ##################################################
  401 #
  402 #  Override the string and TeX methods
  403 #  so that we can strinfigy as inequalities
  404 #  rather than unions.
  405 #
  406 package Inequalities::Union;
  407 our @ISA = ("Value::Union");
  408 
  409 sub new {
  410   my $self = shift; $self = $self->SUPER::new(@_);
  411   $self->{isValue} = 1;
  412   return $self;
  413 }
  414 
  415 sub make {
  416   my $self = shift; $self = $self->SUPER::make(@_);
  417   $self->{isValue} = 1;
  418   return $self;
  419 }
  420 
  421 sub string {
  422   my $self = shift;
  423   return $self->SUPER::string(@_) unless $self->getFlag('stringifyAsInequality');
  424   my $equation = shift; shift; shift; my $prec = shift;
  425   my $op = ($equation->{context} || $self->context)->{operators}{'or'};
  426   my @intervals = ();
  427   foreach my $x (@{$self->data}) {
  428     $x->{format} = $self->{format} if defined $self->{format};
  429     push(@intervals,$x->string($equation))
  430   }
  431   my $string = join($op->{string} || ' or ',@intervals);
  432   $string = '('.$string.')' if $prec > ($op->{precedence} || 1.5);
  433   return $string;
  434 }
  435 
  436 sub TeX {
  437   my $self = shift;
  438   return $self->SUPER::TeX(@_) unless $self->getFlag('stringifyAsInequality');
  439   my $equation = shift; shift; shift; my $prec = shift;
  440   my $op = ($equation->{context} || $self->context)->{operators}{'or'};
  441   my @intervals = ();
  442   foreach my $x (@{$self->data}) {push(@intervals,$x->TeX($equation))}
  443   my $TeX = join($op->{TeX} || $op->{string} || ' or ',@intervals);
  444   $TeX = '\left('.$TeX.'\right)' if $prec > ($op->{precedence} || 1.5);
  445   return $TeX;
  446 }
  447 
  448 ##################################################
  449 #
  450 #  Override the string and TeX methods
  451 #  so that we can strinfigy as inequalities
  452 #  rather than sets.
  453 #
  454 package Inequalities::Set;
  455 our @ISA = ("Value::Set");
  456 
  457 sub new {
  458   my $self = shift; $self = $self->SUPER::new(@_);
  459   $self->{isValue} = 1;
  460   return $self;
  461 }
  462 
  463 sub make {
  464   my $self = shift; $self = $self->SUPER::make(@_);
  465   $self->{isValue} = 1;
  466   return $self;
  467 }
  468 
  469 sub string {
  470   my $self = shift;  my $equation = shift;
  471   return $self->SUPER::string($equation,@_) unless $self->getFlag('stringifyAsInequality');
  472   my $x = ($self->context->variables->names)[0];
  473   $x = $context->{variables}{$x}{string} if defined $context->{variables}{$x}{string};
  474   my @coords = ();
  475   foreach my $a (@{$self->data}) {
  476     if (Value::isValue($a)) {
  477       $a->{format} = $self->{format} if defined $self->{format};
  478       push(@coords,$x.' = '.$a->string($equation));
  479     } else {
  480       push(@coords,$x.' = '.$a);
  481     }
  482   }
  483   return $self->getFlag('noneWord') unless scalar(@coords);
  484   return join(" or ",@coords);
  485 }
  486 
  487 sub TeX {
  488   my $self = shift;  my $equation = shift;
  489   return $self->SUPER::TeX($equation,@_) unless $self->getFlag('stringifyAsInequality');
  490   my $x = ($self->context->variables->names)[0];
  491   $x = $context->{variables}{$x}{TeX} if defined $context->{variables}{$x}{TeX};
  492   $x =~ s/^([^_]+)_?(\d+)$/$1_{$2}/;
  493   my @coords = ();
  494   foreach my $a (@{$self->data}) {
  495     if (Value::isValue($a)) {
  496       $a->{format} = $self->{format} if defined $self->{format};
  497       push(@coords,$x.' = '.$a->TeX($equation));
  498     } else {
  499       push(@coords,$x.' = '.$a);
  500     }
  501   }
  502   return '\hbox{'.$self->getFlag('noneWord').'}' unless scalar(@coords);
  503   return join(" or ",@coords);
  504 }
  505 
  506 ##################################################
  507 
  508 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9