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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : dpvc 2728 loadMacros('Parser.pl');
2 :    
3 :     sub _parserParametricLine_init {}; # don't reload this file
4 :    
5 : gage 4997 =head1 DESCRIPTION
6 :    
7 : dpvc 2728 ######################################################################
8 :     #
9 :     # This is a Parser class that implements parametric lines 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 :     # Use ParametricLine(point,vector) or ParametricLine(formula)
16 :     # to create a ParametricLine object. You can pass an optional
17 :     # additional parameter that indicated the variable to use for the
18 :     # parameter for the line.
19 :     #
20 :     # Usage examples:
21 :     #
22 :     # $L = ParametricLine(Point(3,-1,2),Vector(1,1,3));
23 :     # $L = ParametricLine([3,-1,2],[1,1,3]);
24 :     # $L = ParametricLine("<t,1-t,2t-3>");
25 :     #
26 :     # $p = Point(3,-1,2); $v = Vector(1,1,3);
27 :     # $L = ParametricLine($p,$v);
28 :     #
29 :     # $t = Formula('t'); $p = Point(3,-1,2); $v = Vector(1,1,3);
30 :     # $L = ParametricLine($p+$t*$v);
31 :     #
32 :     # Context()->constants->are(a=>1+pi^2); # won't guess this value
33 :     # $L = ParametricLine("(a,2a,-1) + t <1,a,a^2>");
34 :     #
35 :     # Then use
36 :     #
37 :     # ANS($L->cmp);
38 :     #
39 :     # to get the answer checker for $L.
40 :     #
41 :    
42 : gage 4997 =cut
43 :    
44 : dpvc 2728 #
45 :     # Define a new context for lines
46 :     #
47 : dpvc 5075 $context{ParametricLine} = Parser::Context->getCopy(undef,"Vector");
48 : dpvc 2728 $context{ParametricLine}->variables->are(t=>'Real');
49 : dpvc 5075 $context{ParametricLine}->{precedence}{ParametricLine} =
50 : dpvc 2728 $context{ParametricLine}->{precedence}{special};
51 : dpvc 2934 $context{ParametricLine}->reduction->set('(-x)-y'=>0);
52 : dpvc 2728 #
53 :     # Make it active
54 :     #
55 :     Context("ParametricLine");
56 :    
57 :     #
58 :     # Syntactic sugar
59 :     #
60 :     sub ParametricLine {ParametricLine->new(@_)}
61 :    
62 :     #
63 :     # Define the subclass of Formula
64 :     #
65 :     package ParametricLine;
66 :     our @ISA = qw(Value::Formula);
67 :    
68 :     sub new {
69 :     my $self = shift; my $class = ref($self) || $self;
70 : dpvc 5075 my $context = (Value::isContext($_[0]) ? shift : $self->context);
71 : dpvc 2728 my ($p,$v,$line,$t);
72 :     return shift if scalar(@_) == 1 && ref($_[0]) eq $class;
73 : dpvc 5075 $_[0] = $context->Package("Point")->new($context,$_[0]) if ref($_[0]) eq 'ARRAY';
74 :     $_[1] = $context->Package("Vector")->new($context,$_[1]) if ref($_[1]) eq 'ARRAY';
75 :     if (scalar(@_) >= 2 && Value::classMatch($_[0],'Point') &&
76 :     Value::classMatch($_[1],'Vector')) {
77 : dpvc 2728 $p = shift; $v = shift;
78 : dpvc 5075 $t = shift || $context->Package("Formula")->new($context,'t');
79 : dpvc 2728 $line = $p + $t*$v;
80 :     } else {
81 : dpvc 5075 $line = $context->Package("Formula")->new($context,shift);
82 : dpvc 2728 Value::Error("Your formula doesn't look like a parametric line")
83 :     unless $line->type eq 'Vector';
84 :     $t = shift || (keys %{$line->{variables}})[0];
85 : dpvc 2934 Value::Error("A line can't be just a constant vector") unless $t;
86 : dpvc 5075 $p = $context->Package("Point")->new($context,$line->eval($t=>0));
87 :     $v = $context->Package("Vector")->new($context,$line->eval($t=>1) - $p);
88 : dpvc 3371 Value::Error("Your formula isn't linear in the variable %s",$t)
89 : dpvc 5075 unless $line == $p + $context->Package("Formula")->new($context,$t) * $v;
90 : dpvc 2728 }
91 :     Value::Error("The direction vector for a parametric line can't be the zero vector")
92 :     if ($v->norm == 0);
93 :     $line->{p} = $p; $line->{v} = $v;
94 :     $line->{isValue} = $line->{isFormula} = 1;
95 :     return bless $line, $class;
96 :     }
97 :    
98 : gage 4997 =head3 compare($lhs,$rhs)
99 :    
100 : dpvc 2728 #
101 : dpvc 5075 # Two parametric lines are equal if they have
102 : dpvc 2728 # parallel direction vectors and either the same
103 :     # points or the vector between the points is
104 :     # parallel to the (common) direction vector.
105 :     #
106 : gage 4997
107 : dpvc 5075 =cut
108 : gage 4997
109 : dpvc 2728 sub compare {
110 : dpvc 5075 my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
111 : dpvc 2728 my ($lp,$lv) = ($l->{p},$l->{v});
112 :     my ($rp,$rv) = ($r->{p},$r->{v});
113 :     return $lv <=> $rv unless ($lv->isParallel($rv));
114 :     return 0 if $lp == $rp || $lv->isParallel($rp-$lp);
115 :     return $lp <=> $rp;
116 :     }
117 :    
118 :     sub cmp_class {'a Parametric Line'};
119 : dpvc 4385 sub showClass {shift->cmp_class};
120 : dpvc 2728
121 :     sub cmp_defaults {(
122 :     shift->SUPER::cmp_defaults,
123 :     showEqualErrors => 0, # don't show problems evaluating student answer
124 :     ignoreInfinity => 0, # report infinity as an error
125 :     )}
126 :    
127 :     #
128 :     # Report some errors that were stopped by the showEqualErrors=>0 above.
129 :     #
130 :     sub cmp_postprocess {
131 :     my $self = shift; my $ans = shift;
132 : dpvc 5075 my $error = $sef->context->{error}{message};
133 :     $self->cmp_error($ans)
134 : dpvc 2934 if $error =~ m/^(Your formula (isn't linear|doesn't look)|A line can't|The direction vector)/;
135 : dpvc 2728 }
136 :    
137 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9