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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9