[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 3195 - (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 :     Context("ImplicitPlane");
55 :     #
56 :     # allow equalities in formulas
57 :     #
58 :     Parser::BOP::equality::Allow;
59 :    
60 :     #
61 :     # Syntactic sugar for creating implicit planes
62 :     #
63 :     sub ImplicitPlane {ImplicitPlane->new(@_)}
64 :    
65 :     #
66 :     # Define the subclass of Formula
67 :     #
68 :     package ImplicitPlane;
69 :     our @ISA = qw(Value::Formula);
70 :    
71 :     sub new {
72 :     my $self = shift; my $class = ref($self) || $self;
73 :     return shift if scalar(@_) == 1 && ref($_[0]) eq $class;
74 :     $_[0] = Value::Point->new($_[0]) if ref($_[0]) eq 'ARRAY';
75 :     $_[1] = Value::Vector->new($_[1]) if ref($_[1]) eq 'ARRAY';
76 :    
77 :     my ($p,$N,$plane,$vars,$d,$type); $type = 'plane';
78 :     if (scalar(@_) >= 2 && Value::class($_[0]) =~ m/^(Point|Vector)/ &&
79 :     Value::class($_[1]) eq 'Vector' || Value::isRealNumber($_[1])) {
80 :     #
81 :     # Make a plane from a point and a vector,
82 :     # or from a list of coefficients and the constant
83 :     #
84 :     $p = shift; $N = shift;
85 :     if (Value::class($N) eq 'Vector') {$d = $p.$N}
86 :     else {$d = Value::Real->make($N); $N = Value::Vector->new($p)}
87 :     $vars = shift || [$$Value::context->variables->names];
88 :     $vars = [$vars] unless ref($vars) eq 'ARRAY';
89 :     $type = 'line' if scalar(@{$vars}) == 2;
90 :     my @terms = (); my $i = 0;
91 :     foreach my $x (@{$vars}) {push @terms, $N->{data}[$i++]->string.$x}
92 : dpvc 2935 $plane = Value::Formula->new(join(' + ',@terms).' = '.$d->string)->reduce(@_);
93 : dpvc 2727 } else {
94 :     #
95 :     # Determine the normal vector and d value from the equation
96 :     #
97 :     $plane = shift;
98 :     $plane = Value::Formula->new($plane) unless Value::isValue($plane);
99 :     $vars = shift || [$$Value::context->variables->names];
100 :     $vars = [$vars] unless ref($vars) eq 'ARRAY';
101 :     $type = 'line' if scalar(@{$vars}) == 2;
102 :     Value::Error("Your formula doesn't look like an implicit $type")
103 :     unless $plane->type eq 'Equality';
104 :     #
105 :     # Find the coefficients of the formula
106 :     #
107 : dpvc 3159 my $f = (Value::Formula->new($plane->{tree}{lop}) -
108 :     Value::Formula->new($plane->{tree}{rop}))->reduce;
109 : dpvc 2727 my $F = $f->perlFunction(undef,[@{$vars}]);
110 :     my @v = split('','0' x scalar(@{$vars}));
111 :     $d = -&$F(@v); my @coeff = (@v);
112 :     foreach my $i (0..scalar(@v)-1)
113 :     {$v[$i] = 1; $coeff[$i] = &$F(@v) + $d; $v[$i] = 0}
114 :     #
115 :     # Check that the student's formula really is what we thought
116 :     #
117 :     $N = Value::Vector->new([@coeff]);
118 : dpvc 2935 $plane = ImplicitPlane->new($N,$d,$vars,'-x=-y'=>0,'-x=n'=>0);
119 : dpvc 2727 Value::Error("Your formula isn't a linear one")
120 :     unless (Value::Formula->new($plane->{tree}{lop}) -
121 :     Value::Formula->new($plane->{tree}{rop})) == $f;
122 :     }
123 :     Value::Error("The equation of a $type must be non-zero somewhere")
124 :     if ($N->norm == 0);
125 :     $plane->{d} = $d; $plane->{N} = $N; $plane->{implicit} = $type;
126 :     $plane->{isValue} = $plane->{isFormula} = 1;
127 :     return bless $plane, $class;
128 :     }
129 :    
130 :     #
131 :     # We already know the vectors are none zero, so check
132 :     # if the equations are multiples of each other.
133 :     #
134 :     sub compare {
135 :     my ($l,$r,$flag) = @_;
136 : dpvc 3195 if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
137 : dpvc 2727 $r = ImplicitPlane->new($r);
138 :     if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
139 :     my ($lN,$ld) = ($l->{N},$l->{d});
140 :     my ($rN,$rd) = ($r->{N},$r->{d});
141 : dpvc 2982 if ($rd == 0 || $ld == 0) {
142 :     return $rd <=> $ld unless $ld == $rd;
143 :     return $lN <=> $rN unless (areParallel $lN $rN);
144 :     return 0;
145 :     }
146 : dpvc 2727 return $rd*$lN <=> $ld*$rN;
147 :     }
148 :    
149 :     sub cmp_class {'an Implicit '.(shift->{implicit})};
150 :    
151 :     sub cmp_defaults{(
152 :     shift->SUPER::cmp_defaults,
153 :     ignoreInfinity => 0, # report infinity as an error
154 :     )}
155 :    
156 :     #
157 :     # Only compare two equalities
158 :     #
159 :     sub typeMatch {
160 :     my $self = shift; my $other = shift; my $ans = shift;
161 :     return ref($other) && $self->type eq $other->type;
162 :     }
163 :    
164 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9