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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4298 - (download) (as text) (annotate)
Wed Jul 26 02:54:01 2006 UTC (13 years, 5 months ago) by dpvc
File size: 10993 byte(s)
Extended this context to handle multivariable polynomials.  So you can
use things like

	loadMacros("contextLimitedPolynomial.pl");
	Context("LimitedPolynomial")->variables->are(x => 'Real', y => 'Real');
        Context()->flags->set(singlePowers=>1);
	$f = Formula("1 + x + y + 2xy + x^2 + y^2");

    1 loadMacros("Parser.pl");
    2 
    3 sub _contextLimitedPolynomial_init {}; # don't load it again
    4 
    5 ##########################################################
    6 #
    7 #  Implements a context in which students can only
    8 #  enter (expanded) polynomials (i.e., sums of multiples
    9 #  of powers of x).
   10 #
   11 #  Select the context using:
   12 #
   13 #      Context("LimitedPolynomial");
   14 #
   15 #  If you set the "singlePowers" flag, then only one monomial of
   16 #  each degree can be included in the polynomial:
   17 #
   18 #      Context("LimitedPolynomial")->flags->set(singlePowers=>1);
   19 #
   20 
   21 #
   22 #  Handle common checking for BOPs
   23 #
   24 package LimitedPolynomial::BOP;
   25 
   26 #
   27 #  Do original check and then if the operands are numbers, its OK.
   28 #  Otherwise, do an operator-specific check for if the polynomial is OK.
   29 #  Otherwise report an error.
   30 #
   31 sub _check {
   32   my $self = shift;
   33   my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
   34   &{$super."::_check"}($self);
   35   return if LimitedPolynomial::isConstant($self->{lop}) &&
   36             LimitedPolynomial::isConstant($self->{rop});
   37   return if $self->checkPolynomial;
   38   $self->Error("Your answer doesn't look like a polynomial");
   39 }
   40 
   41 #
   42 #  filled in by subclasses
   43 #
   44 sub checkPolynomial {return 0}
   45 
   46 #
   47 #  Check that the exponents of a monomial are OK
   48 #  and record the new exponent array
   49 #
   50 sub checkExponents {
   51   my $self = shift;
   52   my ($l,$r) = ($self->{lop},$self->{rop});
   53   LimitedPolynomial::markPowers($l);
   54   LimitedPolynomial::markPowers($r);
   55   my $exponents = $self->{exponents} = $r->{exponents};
   56   delete $r->{exponents}; delete $r->{powers};
   57   if ($l->{exponents}) {
   58     my $single = $self->{equation}{context}->flag('singlePowers');
   59     foreach my $i (0..scalar(@{$exponents})-1) {
   60       $self->Error("A variable can appear only once in each term of a polynomial")
   61   if $exponents->[$i] && $l->{exponents}[$i] && $single;
   62       $exponents->[$i] += $l->{exponents}[$i];
   63     }
   64   }
   65   delete $l->{exponents}; delete $l->{powers};
   66   $self->{isPower} = 1; $self->{isPoly} = $l->{isPoly};
   67   return 1;
   68 }
   69 
   70 #
   71 #  Check that the powers of combined monomials are OK
   72 #  and record the new power list
   73 #
   74 sub checkPowers {
   75   my $self = shift;
   76   my ($l,$r) = ($self->{lop},$self->{rop});
   77   my $single = $self->{equation}{context}->flag('singlePowers');
   78   LimitedPolynomial::markPowers($l);
   79   LimitedPolynomial::markPowers($r);
   80   $self->{isPoly} = 1;
   81   $self->{powers} = $l->{powers} || {}; delete $l->{powers};
   82   return 1 unless $r->{powers};
   83   foreach my $n (keys(%{$r->{powers}})) {
   84     $self->Error("Polynomials can have at most one term of each degree")
   85       if $self->{powers}{$n} && $single;
   86     $self->{powers}{$n} = 1;
   87   }
   88   delete $r->{powers};
   89   return 1;
   90 }
   91 
   92 package LimitedPolynomial;
   93 
   94 #
   95 #  Mark a variable as having power 1
   96 #  Mark a monomial as having its given powers
   97 #
   98 sub markPowers {
   99   my $self = shift;
  100   if ($self->class eq 'Variable') {
  101     my $vIndex = LimitedPolynomial::getVarIndex($self);
  102     $self->{index} = $vIndex->{$self->{name}};
  103     $self->{exponents} = [(0) x scalar(keys %{$vIndex})];
  104     $self->{exponents}[$self->{index}] = 1;
  105   }
  106   if ($self->{exponents}) {
  107     my $power = join(',',@{$self->{exponents}});
  108     $self->{powers}{$power} = 1;
  109   }
  110 }
  111 
  112 #
  113 #  Get a hash of variable names that point to indices
  114 #  within the array of powers for a monomial
  115 #
  116 sub getVarIndex {
  117   my $self = shift;
  118   my $equation = $self->{equation};
  119   if (!$equation->{varIndex}) {
  120     $equation->{varIndex} = {}; my $i = 0;
  121     foreach my $v ($equation->{context}->variables->names)
  122       {$equation->{varIndex}{$v} = $i++}
  123   }
  124   return $equation->{varIndex};
  125 }
  126 
  127 #
  128 #  Check for a constant expression
  129 #
  130 sub isConstant {
  131   my $self = shift;
  132   return 1 if $self->{isConstant} || $self->class eq 'Constant';
  133   return scalar(keys(%{$self->getVariables})) == 0;
  134 }
  135 
  136 ##############################################
  137 #
  138 #  Now we get the individual replacements for the operators
  139 #  that we don't want to allow.  We inherit everything from
  140 #  the original Parser::BOP class, and just add the
  141 #  polynomial checks here.  Note that checkpolynomial
  142 #  only gets called if at least one of the terms is not
  143 #  a number.
  144 #
  145 
  146 package LimitedPolynomial::BOP::add;
  147 our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::add);
  148 
  149 sub checkPolynomial {
  150   my $self = shift;
  151   my ($l,$r) = ($self->{lop},$self->{rop});
  152   $self->Error("Addition is allowed only between monomials")
  153     if $r->{isPoly};
  154   $self->checkPowers;
  155 }
  156 
  157 ##############################################
  158 
  159 package LimitedPolynomial::BOP::subtract;
  160 our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::subtract);
  161 
  162 sub checkPolynomial {
  163   my $self = shift;
  164   my ($l,$r) = ($self->{lop},$self->{rop});
  165   $self->Error("Subtraction is only allowed between monomials")
  166     if $r->{isPoly};
  167   $self->checkPowers;
  168 }
  169 
  170 ##############################################
  171 
  172 package LimitedPolynomial::BOP::multiply;
  173 our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::multiply);
  174 
  175 sub checkPolynomial {
  176   my $self = shift;
  177   my ($l,$r) = ($self->{lop},$self->{rop});
  178   my $lOK = (LimitedPolynomial::isConstant($l) || $l->{isPower} ||
  179        $l->class eq 'Variable' || ($l->{isPoly} && $l->{isPoly} == 2));
  180   my $rOK = ($r->{isPower} || $r->class eq 'Variable');
  181   return $self->checkExponents if $lOK and $rOK;
  182   $self->Error("Coefficients must come before variables in a polynomial")
  183     if LimitedPolynomial::isConstant($r) && ($l->{isPower} || $l->class eq 'Variable');
  184   $self->Error("Multiplication can only be used between coefficients and variables");
  185 }
  186 
  187 ##############################################
  188 
  189 package LimitedPolynomial::BOP::divide;
  190 our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::divide);
  191 
  192 sub checkPolynomial {
  193   my $self = shift;
  194   my ($l,$r) = ($self->{lop},$self->{rop});
  195   $self->Error("In a polynomial, you can only divide by numbers")
  196     unless LimitedPolynomial::isConstant($r);
  197   $self->Error("You can only divide a single term by a number")
  198     if $l->{isPoly} && $l->{isPoly} == 1;
  199   $self->{isPoly} = $l->{isPoly};
  200   $self->{powers} = $l->{powers}; delete $l->{powers};
  201   $self->{exponents} = $l->{exponents}; delete $l->{exponents};
  202   return 1;
  203 }
  204 
  205 ##############################################
  206 
  207 package LimitedPolynomial::BOP::power;
  208 our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::power);
  209 
  210 sub checkPolynomial {
  211   my $self = shift;
  212   my ($l,$r) = ($self->{lop},$self->{rop});
  213   $self->Error("You can only raise a variable to a power in a polynomial")
  214     unless $l->class eq 'Variable';
  215   $self->Error("Exponents must be constant in a polynomial")
  216     unless LimitedPolynomial::isConstant($r);
  217   my $n = Parser::Evaluate($r);
  218   $r->Error($$Value::context->{error}{message}) if $$Value::context->{error}{flag};
  219   $n = $n->value;
  220   $self->Error("Exponents must be positive integers in a polynomial")
  221     unless $n > 0 && $n == int($n);
  222   LimitedPolynomial::markPowers($l);
  223   $self->{exponents} = $l->{exponents}; delete $l->{exponents};
  224   foreach my $i (@{$self->{exponents}}) {$i = $n if $i}
  225   $self->{isPower} = 1;
  226   return 1;
  227 }
  228 
  229 ##############################################
  230 ##############################################
  231 #
  232 #  Now we do the same for the unary operators
  233 #
  234 
  235 package LimitedPolynomial::UOP;
  236 
  237 sub _check {
  238   my $self = shift;
  239   my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
  240   &{$super."::_check"}($self);
  241   my $op = $self->{op};
  242   return if LimitedPolynomial::isConstant($op);
  243   $self->Error("You can only use '%s' with monomials",$self->{def}{string})
  244     if $op->{isPoly};
  245   $self->{isPoly} = 2;
  246   $self->{powers} = $op->{powers}; delete $op->{powers};
  247   $self->{exponents} = $op->{exponents}; delete $op->{exponents};
  248 }
  249 
  250 sub checkPolynomial {return 0}
  251 
  252 ##############################################
  253 
  254 package LimitedPolynomial::UOP::plus;
  255 our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::plus);
  256 
  257 ##############################################
  258 
  259 package LimitedPolynomial::UOP::minus;
  260 our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::minus);
  261 
  262 ##############################################
  263 ##############################################
  264 #
  265 #  Don't allow absolute values
  266 #
  267 
  268 package LimitedPolynomial::List::AbsoluteValue;
  269 our @ISA = qw(Parser::List::AbsoluteValue);
  270 
  271 sub _check {
  272   my $self = shift;
  273   $self->SUPER::_check;
  274   return if LimitedPolynomial::isConstant($self->{coords}[0]);
  275   $self->Error("Can't use absolute values in polynomials");
  276 }
  277 
  278 ##############################################
  279 ##############################################
  280 #
  281 #  Only allow numeric function calls
  282 #
  283 
  284 package LimitedPolynomial::Function;
  285 
  286 sub _check {
  287   my $self = shift;
  288   my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
  289   &{$super."::_check"}($self);
  290   my $arg = $self->{params}->[0];
  291   return if LimitedPolynomial::isConstant($arg);
  292   $self->Error("Function '%s' can only be used with numbers",$self->{name});
  293 }
  294 
  295 
  296 package LimitedPolynomial::Function::numeric;
  297 our @ISA = qw(LimitedPolynomial::Function Parser::Function::numeric);
  298 
  299 package LimitedPolynomial::Function::trig;
  300 our @ISA = qw(LimitedPolynomial::Function Parser::Function::trig);
  301 
  302 package LimitedPolynomial::Function::hyperbolic;
  303 our @ISA = qw(LimitedPolynomial::Function Parser::Function::hyperbolic);
  304 
  305 ##############################################
  306 ##############################################
  307 
  308 package main;
  309 
  310 #
  311 #  Now build the new context that calls the
  312 #  above classes rather than the usual ones
  313 #
  314 
  315 $context{LimitedPolynomial} = Context("Numeric");
  316 $context{LimitedPolynomial}->operators->set(
  317    '+' => {class => 'LimitedPolynomial::BOP::add'},
  318    '-' => {class => 'LimitedPolynomial::BOP::subtract'},
  319    '*' => {class => 'LimitedPolynomial::BOP::multiply'},
  320   '* ' => {class => 'LimitedPolynomial::BOP::multiply'},
  321   ' *' => {class => 'LimitedPolynomial::BOP::multiply'},
  322    ' ' => {class => 'LimitedPolynomial::BOP::multiply'},
  323    '/' => {class => 'LimitedPolynomial::BOP::divide'},
  324   ' /' => {class => 'LimitedPolynomial::BOP::divide'},
  325   '/ ' => {class => 'LimitedPolynomial::BOP::divide'},
  326    '^' => {class => 'LimitedPolynomial::BOP::power'},
  327   '**' => {class => 'LimitedPolynomial::BOP::power'},
  328   'u+' => {class => 'LimitedPolynomial::UOP::plus'},
  329   'u-' => {class => 'LimitedPolynomial::UOP::minus'},
  330 );
  331 #
  332 #  Remove these operators and functions
  333 #
  334 $context{LimitedPolynomial}->lists->set(
  335   AbsoluteValue => {class => 'LimitedPolynomial::List::AbsoluteValue'},
  336 );
  337 $context{LimitedPolynomial}->operators->undefine('_','!','U');
  338 $context{LimitedPolynomial}->functions->disable("atan2");
  339 #
  340 #  Hook into the numeric, trig, and hyperbolic functions
  341 #
  342 foreach ('ln','log','log10','exp','sqrt','abs','int','sgn') {
  343   $context{LimitedPolynomial}->functions->set(
  344     "$_"=>{class => 'LimitedPolynomial::Function::numeric'}
  345   );
  346 }
  347 foreach ('sin','cos','tan','sec','csc','cot',
  348          'asin','acos','atan','asec','acsc','acot') {
  349   $context{LimitedPolynomial}->functions->set(
  350      "$_"=>{class => 'LimitedPolynomial::Function::trig'},
  351      "${_}h"=>{class => 'LimitedPolynomial::Function::hyperbolic'}
  352   );
  353 }
  354 
  355 Context("LimitedPolynomial");

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9