[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 5441 - (download) (as text) (annotate)
Tue Aug 28 22:40:15 2007 UTC (12 years, 5 months ago) by dpvc
File size: 6713 byte(s)
Add context names for the context(s) created here.

    1 loadMacros('MathObjects.pl');
    2 
    3 sub _parserImplicitPlane_init {ImplicitPlane::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 #
   55 #  Define the subclass of Formula
   56 #
   57 package ImplicitPlane;
   58 our @ISA = qw(Value::Formula);
   59 
   60 sub Init {
   61   my $context = $main::context{ImplicitPlane} = Parser::Context->getCopy("Vector");
   62   $context->{name} = "ImplicitPlane";
   63   $context->{precedence}{ImplicitPlane} = $context->{precedence}{special};
   64   #$context->{value}{Equality} = "ImplicitPlane::equality";
   65   Parser::BOP::equality->Allow($context);
   66   $context->operators->set('=' => {class => 'ImplicitPlane::equality'});
   67 
   68   main::Context("ImplicitPlane");  ### FIXME:  probably should require authors to set this explicitly
   69 
   70   main::PG_restricted_eval('sub ImplicitPlane {ImplicitPlane->new(@_)}');
   71 }
   72 
   73 sub new {
   74   my $self = shift; my $class = ref($self) || $self;
   75   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   76   return shift if scalar(@_) == 1 && ref($_[0]) eq 'ImplicitPlane';
   77   $_[0] = $context->Package("Point")->new($context,$_[0]) if ref($_[0]) eq 'ARRAY';
   78   $_[1] = $context->Package("Vector")->new($context,$_[1]) if ref($_[1]) eq 'ARRAY';
   79 
   80   my ($p,$N,$plane,$vars,$d,$type); $type = 'plane';
   81   if (scalar(@_) >= 2 && Value::classMatch($_[0],'Point','Vector') &&
   82       Value::classMatch($_[1],'Vector') || Value::isRealNumber($_[1])) {
   83     #
   84     # Make a plane from a point and a vector,
   85     # or from a list of coefficients and the constant
   86     #
   87     $p = shift; $N = shift;
   88     if (Value::classMatch($N,'Vector')) {
   89       $d = $p.$N;
   90     } else {
   91       $d = $context->Package("Real")->make($context,$N);
   92       $N = $context->Package("Vector")->new($context,$p);
   93     }
   94     $vars = shift || [$context->variables->names];
   95     $vars = [$vars] unless ref($vars) eq 'ARRAY';
   96     $type = 'line' if scalar(@{$vars}) == 2;
   97     my @terms = (); my $i = 0;
   98     foreach my $x (@{$vars}) {push @terms, $N->{data}[$i++]->string.$x}
   99     $plane = $context->Package("Formula")->new(join(' + ',@terms).' = '.$d->string)->reduce(@_);
  100   } else {
  101     $formula = $context->Package("Formula");
  102     #
  103     #  Determine the normal vector and d value from the equation
  104     #
  105     $plane = shift;
  106     $plane = $formula->new($context,$plane) unless Value::isValue($plane);
  107     $vars = shift || [$context->variables->names];
  108     $vars = [$vars] unless ref($vars) eq 'ARRAY';
  109     $type = 'line' if scalar(@{$vars}) == 2;
  110     Value::Error("Your formula doesn't look like an implicit %s",$type)
  111       unless $plane->type eq 'Equality';
  112     #
  113     #  Find the coefficients of the formula
  114     #
  115     my $f = ($formula->new($context,$plane->{tree}{lop}) -
  116        $formula->new($context,$plane->{tree}{rop}))->reduce;
  117     my $F = $f->perlFunction(undef,[@{$vars}]);
  118     my @v = split('','0' x scalar(@{$vars}));
  119     $d = -&$F(@v); my @coeff = (@v);
  120     foreach my $i (0..scalar(@v)-1)
  121       {$v[$i] = 1; $coeff[$i] = &$F(@v) + $d; $v[$i] = 0}
  122     #
  123     #  Check that the student's formula really is what we thought
  124     #
  125     $N = Value::Vector->new([@coeff]);
  126     $plane = ImplicitPlane->new($N,$d,$vars,'-x=-y'=>0,'-x=n'=>0);
  127     Value::Error("Your formula isn't a linear one")
  128       unless ($formula->new($plane->{tree}{lop}) -
  129               $formula->new($plane->{tree}{rop})) == $f;
  130     $plane = $plane->reduce;
  131   }
  132   Value::Error("The equation of a %s must be non-zero somewhere",$type)
  133     if ($N->norm == 0);
  134   $plane->{d} = $d; $plane->{N} = $N; $plane->{implicit} = $type;
  135   return bless $plane, $class;
  136 }
  137 
  138 #
  139 #  We already know the vectors are non-zero, so check
  140 #  if the equations are multiples of each other.
  141 #
  142 sub compare {
  143   my ($self,$l,$r) = Value::checkOpOrder(@_);
  144   $r = new ImplicitPlane($r);# if ref($r) ne ref($self);
  145   my ($lN,$ld) = ($l->{N},$l->{d});
  146   my ($rN,$rd) = ($r->{N},$r->{d});
  147   if ($rd == 0 || $ld == 0) {
  148     return $rd <=> $ld unless $ld == $rd;
  149     return $lN <=> $rN unless (areParallel $lN $rN);
  150     return 0;
  151   }
  152   return $rd*$lN <=> $ld*$rN;
  153 }
  154 
  155 sub cmp_class {'an Implicit '.(shift->{implicit})};
  156 sub showClass {shift->cmp_class};
  157 
  158 sub cmp_defaults{(
  159   Value::Real::cmp_defaults(shift),
  160   ignoreInfinity => 0,    # report infinity as an error
  161 )}
  162 
  163 #
  164 #  Only compare two equalities
  165 #
  166 sub typeMatch {
  167   my $self = shift; my $other = shift; my $ans = shift;
  168   return ref($other) && $other->type eq 'Equality' unless ref($self);
  169   return ref($other) && $self->type eq $other->type;
  170 }
  171 
  172 #
  173 #  We subclass BOP::equality so that we can give a warning about
  174 #  things like 1 = 3
  175 #
  176 package ImplicitPlane::equality;
  177 our @ISA = qw(Parser::BOP::equality);
  178 
  179 sub _check {
  180   my $self = shift;
  181   $self->SUPER::_check;
  182   $self->Error("An implicit equation can't be constant on both sides")
  183     if $self->{lop}{isConstant} && $self->{rop}{isConstant};
  184 }
  185 
  186 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9