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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4385 - (download) (as text) (annotate)
Wed Aug 16 01:42:46 2006 UTC (13 years, 4 months ago) by dpvc
File size: 7107 byte(s)
Report the objec type better in parser error messages.

    1 loadMacros('Parser.pl');
    2 
    3 sub _parserImplicitPlane_init {}; # don't reload this file
    4 
    5 ######################################################################
    6 #
    7 #  This is a Parser class that implements implicit planes as
    8 #  a subclass of the Formula class.  The standard ->cmp routine
    9 #  will work for this, provided we define the compare() function
   10 #  needed by the overloaded ==.  We assign the special precedence
   11 #  so that overloaded operations will be promoted to the ones below.
   12 #
   13 #
   14 #  Use ImplicitPlane(point,vector), ImplicitPlane(point,number) or
   15 #  ImplicitPlane(formula) to create an ImplicitPlane object.
   16 #  The first form uses the point as a point on the plane and the
   17 #  vector as the normal for the plane.  The second form uses the point
   18 #  as the coefficients of the variables and the number as the value
   19 #  that the formula must equal.  The third form uses the formula
   20 #  directly.
   21 #
   22 #  The number of variables in the Context determines the dimension of
   23 #  the "plane" being defined.  If there are only two, the formula
   24 #  produces an implicit line, but if there are four variables, it will
   25 #  be a hyperplane in four-space.  You can specify the variables you
   26 #  want to use by supplying an additional parameter, which is a
   27 #  reference to an array of variable names.
   28 #
   29 #
   30 #  Usage examples:
   31 #
   32 #     $P = ImplicitPlane(Point(1,0,2),Vector(-1,1,3)); #  -x+y+3z = 5
   33 #     $P = ImplicitPlane([1,0,2],[-1,1,3]);            #  -x+y+3z = 5
   34 #     $P = ImplicitPlane([1,0,2],4);                   #  x+2z = 4
   35 #     $P = ImplicitPlane("x+2y-z=5");
   36 #
   37 #     Context()->variables->are(x=>'Real',y=>'Real',z=>'Real',w=>'Real');
   38 #     $P = ImplicitPlane([1,0,2,-1],10);               # w+2y-z = 10 (alphabetical order)
   39 #     $P = ImplicitPlane([3,-1,2,4],5,['x','y','z','w']);  # 3x-y+2z+4w = 5
   40 #     $P = ImplicitPlane([3,-1,2],5,['y','z','w']);  # 3y-z+2w = 5
   41 #
   42 #  Then use
   43 #
   44 #     ANS($P->cmp);
   45 #
   46 #  to get the answer checker for $P.
   47 #
   48 
   49 #
   50 #  Create a context for implicit planes and activate it
   51 #
   52 $context{ImplicitPlane} = Context("Vector")->copy();
   53 $context{ImplicitPlane}->{precedence}{ImplicitPlane} = Context()->{precedence}{special};
   54 $context{ImplicitPlane}->{value}{Formula} = "ImplicitPlane";
   55 Context("ImplicitPlane");
   56 #
   57 # allow equalities in formulas
   58 #
   59 Parser::BOP::equality::Allow;
   60 $context{ImplicitPlane}->operators->set('=' => {class => 'ImplicitPlane::equality'});
   61 
   62 #
   63 #  Syntactic sugar for creating implicit planes
   64 #
   65 sub ImplicitPlane {ImplicitPlane->new(@_)}
   66 
   67 #
   68 #  Define the subclass of Formula
   69 #
   70 package ImplicitPlane;
   71 our @ISA = qw(Value::Formula);
   72 
   73 sub new {
   74   my $self = shift; my $class = ref($self) || $self;
   75   return shift if scalar(@_) == 1 && ref($_[0]) eq $class;
   76   $_[0] = Value::Point->new($_[0]) if ref($_[0]) eq 'ARRAY';
   77   $_[1] = Value::Vector->new($_[1]) if ref($_[1]) eq 'ARRAY';
   78 
   79   my ($p,$N,$plane,$vars,$d,$type); $type = 'plane';
   80   if (scalar(@_) >= 2 && Value::class($_[0]) =~ m/^(Point|Vector)/ &&
   81       Value::class($_[1]) eq 'Vector' || Value::isRealNumber($_[1])) {
   82     #
   83     # Make a plane from a point and a vector,
   84     # or from a list of coefficients and the constant
   85     #
   86     $p = shift; $N = shift;
   87     if (Value::class($N) eq 'Vector') {$d = $p.$N}
   88       else {$d = Value::Real->make($N); $N = Value::Vector->new($p)}
   89     $vars = shift || [$$Value::context->variables->names];
   90     $vars = [$vars] unless ref($vars) eq 'ARRAY';
   91     $type = 'line' if scalar(@{$vars}) == 2;
   92     my @terms = (); my $i = 0;
   93     foreach my $x (@{$vars}) {push @terms, $N->{data}[$i++]->string.$x}
   94     $plane = Value::Formula->create(join(' + ',@terms).' = '.$d->string)->reduce(@_);
   95   } else {
   96     #
   97     #  Determine the normal vector and d value from the equation
   98     #
   99     $plane = shift;
  100     $plane = Value::Formula->new($plane) unless Value::isValue($plane);
  101     $vars = shift || [$$Value::context->variables->names];
  102     $vars = [$vars] unless ref($vars) eq 'ARRAY';
  103     $type = 'line' if scalar(@{$vars}) == 2;
  104     Value::Error("Your formula doesn't look like an implicit %s",$type)
  105       unless $plane->type eq 'Equality';
  106     #
  107     #  Find the coefficients of the formula
  108     #
  109     my $f = (Value::Formula->new($plane->{tree}{lop}) -
  110        Value::Formula->new($plane->{tree}{rop}))->reduce;
  111     my $F = $f->perlFunction(undef,[@{$vars}]);
  112     my @v = split('','0' x scalar(@{$vars}));
  113     $d = -&$F(@v); my @coeff = (@v);
  114     foreach my $i (0..scalar(@v)-1)
  115       {$v[$i] = 1; $coeff[$i] = &$F(@v) + $d; $v[$i] = 0}
  116     #
  117     #  Check that the student's formula really is what we thought
  118     #
  119     $N = Value::Vector->new([@coeff]);
  120     $plane = ImplicitPlane->new($N,$d,$vars,'-x=-y'=>0,'-x=n'=>0);
  121     Value::Error("Your formula isn't a linear one")
  122       unless (Value::Formula->new($plane->{tree}{lop}) -
  123               Value::Formula->new($plane->{tree}{rop})) == $f;
  124     $plane = $plane->reduce;
  125   }
  126   Value::Error("The equation of a %s must be non-zero somewhere",$type)
  127     if ($N->norm == 0);
  128   $plane->{d} = $d; $plane->{N} = $N; $plane->{implicit} = $type;
  129   $plane->{isValue} = $plane->{isFormula} = 1;
  130   return bless $plane, $class;
  131 }
  132 
  133 #
  134 #  Substitute for Context()->{value}{Formula} which creates
  135 #    an implicit plane if there is an equality, otherwise
  136 #    creates a regular formula.
  137 #
  138 sub create {
  139   my $self = shift; my $f = shift;
  140   return $f if Value::isFormula($f);
  141   my $isEquals = ref($f) eq 'ImplicitPlane::equality';
  142   $f = bless $f, 'Parser::BOP::equality' if $isEquals;  # so Parser will recognize it
  143   $f = Value::Formula->create($f,@_);
  144   $f = $self->new($f) if $isEquals || ref($f->{tree}) eq 'ImplicitPlane::equality';
  145   return $f;
  146 }
  147 
  148 #
  149 #  We already know the vectors are non-zero, so check
  150 #  if the equations are multiples of each other.
  151 #  (If the comparison is to a string, mark it wrong, otherwise
  152 #   turn the right-hand side into an implicit plane)
  153 #
  154 sub compare {
  155   my ($l,$r,$flag) = @_;
  156   if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
  157   return 1 if Value::isValue($r) && $r->type eq 'String';
  158   $r = ImplicitPlane->new($r);
  159   if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
  160   my ($lN,$ld) = ($l->{N},$l->{d});
  161   my ($rN,$rd) = ($r->{N},$r->{d});
  162   if ($rd == 0 || $ld == 0) {
  163     return $rd <=> $ld unless $ld == $rd;
  164     return $lN <=> $rN unless (areParallel $lN $rN);
  165     return 0;
  166   }
  167   return $rd*$lN <=> $ld*$rN;
  168 }
  169 
  170 sub cmp_class {'an Implicit '.(shift->{implicit})};
  171 sub showClass {shift->cmp_class};
  172 
  173 sub cmp_defaults{(
  174   shift->SUPER::cmp_defaults,
  175   ignoreInfinity => 0,    # report infinity as an error
  176 )}
  177 
  178 #
  179 #  Only compare two equalities
  180 #
  181 sub typeMatch {
  182   my $self = shift; my $other = shift; my $ans = shift;
  183   return ref($other) && $other->type eq 'Equality' unless ref($self);
  184   return ref($other) && $self->type eq $other->type;
  185 }
  186 
  187 #
  188 #  We subclass BOP::equality so that we can give a warning about
  189 #  things like 1 = 3
  190 #
  191 package ImplicitPlane::equality;
  192 our @ISA = qw(Parser::BOP::equality);
  193 
  194 sub _check {
  195   my $self = shift;
  196   $self->SUPER::_check;
  197   $self->Error("An implicit equation can't be constant on both sides")
  198     if $self->{lop}{isConstant} && $self->{rop}{isConstant};
  199 }
  200 
  201 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9