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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3679 - (view) (download) (as text)

1 : dpvc 2727 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 : dpvc 3679 $context{ImplicitPlane}->{value}{Formula} = "ImplicitPlane";
55 : dpvc 2727 Context("ImplicitPlane");
56 :     #
57 :     # allow equalities in formulas
58 :     #
59 :     Parser::BOP::equality::Allow;
60 : dpvc 3679 $context{ImplicitPlane}->operators->set('=' => {class => 'ImplicitPlane::equality'});
61 : dpvc 2727
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 : dpvc 3679 $plane = Value::Formula->create(join(' + ',@terms).' = '.$d->string)->reduce(@_);
95 : dpvc 2727 } 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 : dpvc 3371 Value::Error("Your formula doesn't look like an implicit %s",$type)
105 : dpvc 2727 unless $plane->type eq 'Equality';
106 :     #
107 :     # Find the coefficients of the formula
108 :     #
109 : dpvc 3159 my $f = (Value::Formula->new($plane->{tree}{lop}) -
110 :     Value::Formula->new($plane->{tree}{rop}))->reduce;
111 : dpvc 2727 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 : dpvc 2935 $plane = ImplicitPlane->new($N,$d,$vars,'-x=-y'=>0,'-x=n'=>0);
121 : dpvc 2727 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 : dpvc 3679 $plane = $plane->reduce;
125 : dpvc 2727 }
126 : dpvc 3371 Value::Error("The equation of a %s must be non-zero somewhere",$type)
127 : dpvc 2727 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 : dpvc 3679 # 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 :     my $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 : dpvc 2727 # if the equations are multiples of each other.
151 : dpvc 3679 # (If the comparison is to a string, mark it wrong, otherwise
152 :     # turn the right-hand side into an implicit plane)
153 : dpvc 2727 #
154 :     sub compare {
155 :     my ($l,$r,$flag) = @_;
156 : dpvc 3195 if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
157 : dpvc 3679 return 1 if Value::isValue($r) && $r->type eq 'String';
158 : dpvc 2727 $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 : dpvc 2982 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 : dpvc 2727 return $rd*$lN <=> $ld*$rN;
168 :     }
169 :    
170 :     sub cmp_class {'an Implicit '.(shift->{implicit})};
171 :    
172 :     sub cmp_defaults{(
173 :     shift->SUPER::cmp_defaults,
174 :     ignoreInfinity => 0, # report infinity as an error
175 :     )}
176 :    
177 :     #
178 :     # Only compare two equalities
179 :     #
180 :     sub typeMatch {
181 :     my $self = shift; my $other = shift; my $ans = shift;
182 : dpvc 3679 return ref($other) && $other->type eq 'Equality' unless ref($self);
183 : dpvc 2727 return ref($other) && $self->type eq $other->type;
184 :     }
185 :    
186 : dpvc 3679 #
187 :     # We subclass BOP::equality so that we can give a warning about
188 :     # things like 1 = 3
189 :     #
190 :     package ImplicitPlane::equality;
191 :     our @ISA = qw(Parser::BOP::equality);
192 :    
193 :     sub _check {
194 :     my $self = shift;
195 :     $self->SUPER::_check;
196 :     $self->Error("An implicit equation can't be constant on both sides")
197 :     if $self->{lop}{isConstant} && $self->{rop}{isConstant};
198 :     }
199 :    
200 : dpvc 2727 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9