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

Diff of /trunk/pg/macros/contextLimitedPolynomial.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 4121 Revision 4298
42# filled in by subclasses 42# filled in by subclasses
43# 43#
44sub checkPolynomial {return 0} 44sub checkPolynomial {return 0}
45 45
46# 46#
47# Check that the exponents of a monomial are OK
48# and record the new exponent array
49#
50sub checkExponents {
51 my $self = shift;
52 my ($l,$r) = ($self->{lop},$self->{rop});
53 LimitedPolynomial::markPowers($l);
54 LimitedPolynomial::markPowers($r);
55 my $exponents = $self->{exponents} = $r->{exponents};
56 delete $r->{exponents}; delete $r->{powers};
57 if ($l->{exponents}) {
58 my $single = $self->{equation}{context}->flag('singlePowers');
59 foreach my $i (0..scalar(@{$exponents})-1) {
60 $self->Error("A variable can appear only once in each term of a polynomial")
61 if $exponents->[$i] && $l->{exponents}[$i] && $single;
62 $exponents->[$i] += $l->{exponents}[$i];
63 }
64 }
65 delete $l->{exponents}; delete $l->{powers};
66 $self->{isPower} = 1; $self->{isPoly} = $l->{isPoly};
67 return 1;
68}
69
70#
47# Check that the powers of combined monomials are OK 71# Check that the powers of combined monomials are OK
48# and record the new power list 72# and record the new power list
49# 73#
50sub checkPowers { 74sub checkPowers {
51 my $self = shift; 75 my $self = shift;
52 my ($l,$r) = ($self->{lop},$self->{rop}); 76 my ($l,$r) = ($self->{lop},$self->{rop});
53 my $single = $self->{equation}{context}->flag('singlePowers'); 77 my $single = $self->{equation}{context}->flag('singlePowers');
54 $l->{powers} = {1=>1} if $l->class eq 'Variable'; 78 LimitedPolynomial::markPowers($l);
55 $r->{powers} = {1=>1} if $r->class eq 'Variable'; 79 LimitedPolynomial::markPowers($r);
56 $self->{isPoly} = 1; 80 $self->{isPoly} = 1;
57 $self->{powers} = $l->{powers}? {%{$l->{powers}}} : {}; 81 $self->{powers} = $l->{powers} || {}; delete $l->{powers};
58 return 1 unless $r->{powers}; 82 return 1 unless $r->{powers};
59 foreach my $n (keys(%{$r->{powers}})) { 83 foreach my $n (keys(%{$r->{powers}})) {
60 $self->Error("Polynomials can have at most one term of each degree") 84 $self->Error("Polynomials can have at most one term of each degree")
61 if $self->{powers}{$n} && $single; 85 if $self->{powers}{$n} && $single;
62 $self->{powers}{$n} = 1; 86 $self->{powers}{$n} = 1;
63 } 87 }
88 delete $r->{powers};
64 return 1; 89 return 1;
65} 90}
66 91
67package LimitedPolynomial; 92package LimitedPolynomial;
93
94#
95# Mark a variable as having power 1
96# Mark a monomial as having its given powers
97#
98sub markPowers {
99 my $self = shift;
100 if ($self->class eq 'Variable') {
101 my $vIndex = LimitedPolynomial::getVarIndex($self);
102 $self->{index} = $vIndex->{$self->{name}};
103 $self->{exponents} = [(0) x scalar(keys %{$vIndex})];
104 $self->{exponents}[$self->{index}] = 1;
105 }
106 if ($self->{exponents}) {
107 my $power = join(',',@{$self->{exponents}});
108 $self->{powers}{$power} = 1;
109 }
110}
111
112#
113# Get a hash of variable names that point to indices
114# within the array of powers for a monomial
115#
116sub getVarIndex {
117 my $self = shift;
118 my $equation = $self->{equation};
119 if (!$equation->{varIndex}) {
120 $equation->{varIndex} = {}; my $i = 0;
121 foreach my $v ($equation->{context}->variables->names)
122 {$equation->{varIndex}{$v} = $i++}
123 }
124 return $equation->{varIndex};
125}
68 126
69# 127#
70# Check for a constant expression 128# Check for a constant expression
71# 129#
72sub isConstant { 130sub isConstant {
115our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::multiply); 173our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::multiply);
116 174
117sub checkPolynomial { 175sub checkPolynomial {
118 my $self = shift; 176 my $self = shift;
119 my ($l,$r) = ($self->{lop},$self->{rop}); 177 my ($l,$r) = ($self->{lop},$self->{rop});
120 if (LimitedPolynomial::isConstant($l) && ($r->{isPower} || $r->class eq 'Variable')) { 178 my $lOK = (LimitedPolynomial::isConstant($l) || $l->{isPower} ||
121 $r->{powers} = {1=>1} unless $r->{isPower}; 179 $l->class eq 'Variable' || ($l->{isPoly} && $l->{isPoly} == 2));
122 $self->{powers} = {%{$r->{powers}}}; 180 my $rOK = ($r->{isPower} || $r->class eq 'Variable');
123 return 1; 181 return $self->checkExponents if $lOK and $rOK;
124 }
125 $self->Error("Coefficients must come before variables in a polynomial") 182 $self->Error("Coefficients must come before variables in a polynomial")
126 if LimitedPolynomial::isConstant($r) && ($l->{isPower} || $l->class eq 'Variable'); 183 if LimitedPolynomial::isConstant($r) && ($l->{isPower} || $l->class eq 'Variable');
127 $self->Error("Multiplication can only be used between coefficients and variables"); 184 $self->Error("Multiplication can only be used between coefficients and variables");
128} 185}
129 186
133our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::divide); 190our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::divide);
134 191
135sub checkPolynomial { 192sub checkPolynomial {
136 my $self = shift; 193 my $self = shift;
137 my ($l,$r) = ($self->{lop},$self->{rop}); 194 my ($l,$r) = ($self->{lop},$self->{rop});
138 $self->Error("You can only divide by a number in a polynomial") 195 $self->Error("In a polynomial, you can only divide by numbers")
139 unless LimitedPolynomial::isConstant($r); 196 unless LimitedPolynomial::isConstant($r);
140 $self->Error("You can only divide a single monomial by a number") 197 $self->Error("You can only divide a single term by a number")
141 if $l->{isPoly} && $l->{isPoly} == 1; 198 if $l->{isPoly} && $l->{isPoly} == 1;
142 $self->{isPoly} = $l->{isPoly}; 199 $self->{isPoly} = $l->{isPoly};
143 $self->{powers} = {%{$l->{powers}}} if $l->{powers}; 200 $self->{powers} = $l->{powers}; delete $l->{powers};
201 $self->{exponents} = $l->{exponents}; delete $l->{exponents};
144 return 1; 202 return 1;
145} 203}
146 204
147############################################## 205##############################################
148 206
150our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::power); 208our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::power);
151 209
152sub checkPolynomial { 210sub checkPolynomial {
153 my $self = shift; 211 my $self = shift;
154 my ($l,$r) = ($self->{lop},$self->{rop}); 212 my ($l,$r) = ($self->{lop},$self->{rop});
155 $self->{isPower} = 1;
156 $self->Error("You can only raise a variable to a power in a polynomial") 213 $self->Error("You can only raise a variable to a power in a polynomial")
157 unless $l->class eq 'Variable'; 214 unless $l->class eq 'Variable';
158 $self->Error("Exponents must be constant in a polynomial") 215 $self->Error("Exponents must be constant in a polynomial")
159 unless LimitedPolynomial::isConstant($r); 216 unless LimitedPolynomial::isConstant($r);
160 my $n = Parser::Evaluate($r); 217 my $n = Parser::Evaluate($r);
161 $r->Error($$Value::context->{error}{message}) if $$Value::context->{error}{flag}; 218 $r->Error($$Value::context->{error}{message}) if $$Value::context->{error}{flag};
219 $n = $n->value;
162 $self->Error("Exponents must be positive integers in a polynomial") 220 $self->Error("Exponents must be positive integers in a polynomial")
163 unless $n > 0 && $n == int($n); 221 unless $n > 0 && $n == int($n);
222 LimitedPolynomial::markPowers($l);
223 $self->{exponents} = $l->{exponents}; delete $l->{exponents};
224 foreach my $i (@{$self->{exponents}}) {$i = $n if $i}
164 $self->{powers} = {$n=>1}; 225 $self->{isPower} = 1;
165 return 1; 226 return 1;
166} 227}
167 228
168############################################## 229##############################################
169############################################## 230##############################################
180 my $op = $self->{op}; 241 my $op = $self->{op};
181 return if LimitedPolynomial::isConstant($op); 242 return if LimitedPolynomial::isConstant($op);
182 $self->Error("You can only use '%s' with monomials",$self->{def}{string}) 243 $self->Error("You can only use '%s' with monomials",$self->{def}{string})
183 if $op->{isPoly}; 244 if $op->{isPoly};
184 $self->{isPoly} = 2; 245 $self->{isPoly} = 2;
185 $self->{powers} = {%{$op->{powers}}} if $op->{powers}; 246 $self->{powers} = $op->{powers}; delete $op->{powers};
247 $self->{exponents} = $op->{exponents}; delete $op->{exponents};
186} 248}
187 249
188sub checkPolynomial {return 0} 250sub checkPolynomial {return 0}
189 251
190############################################## 252##############################################
234package LimitedPolynomial::Function::numeric; 296package LimitedPolynomial::Function::numeric;
235our @ISA = qw(LimitedPolynomial::Function Parser::Function::numeric); 297our @ISA = qw(LimitedPolynomial::Function Parser::Function::numeric);
236 298
237package LimitedPolynomial::Function::trig; 299package LimitedPolynomial::Function::trig;
238our @ISA = qw(LimitedPolynomial::Function Parser::Function::trig); 300our @ISA = qw(LimitedPolynomial::Function Parser::Function::trig);
301
302package LimitedPolynomial::Function::hyperbolic;
303our @ISA = qw(LimitedPolynomial::Function Parser::Function::hyperbolic);
239 304
240############################################## 305##############################################
241############################################## 306##############################################
242 307
243package main; 308package main;
268# 333#
269$context{LimitedPolynomial}->lists->set( 334$context{LimitedPolynomial}->lists->set(
270 AbsoluteValue => {class => 'LimitedPolynomial::List::AbsoluteValue'}, 335 AbsoluteValue => {class => 'LimitedPolynomial::List::AbsoluteValue'},
271); 336);
272$context{LimitedPolynomial}->operators->undefine('_','!','U'); 337$context{LimitedPolynomial}->operators->undefine('_','!','U');
273$context{LimitedPolynomial}->functions->disable("Hyperbolic","atan2"); 338$context{LimitedPolynomial}->functions->disable("atan2");
274# 339#
275# Hook into the numeric and trig functions 340# Hook into the numeric, trig, and hyperbolic functions
276# 341#
277foreach ('sin','cos','tan','sec','csc','cot',
278 'asin','acos','atan','asec','acsc','acot') {
279 $context{LimitedPolynomial}->functions->set(
280 "$_"=>{class => 'LimitedPolynomial::Function::trig'}
281 );
282}
283foreach ('ln','log','log10','exp','sqrt','abs','int','sgn') { 342foreach ('ln','log','log10','exp','sqrt','abs','int','sgn') {
284 $context{LimitedPolynomial}->functions->set( 343 $context{LimitedPolynomial}->functions->set(
285 "$_"=>{class => 'LimitedPolynomial::Function::numeric'} 344 "$_"=>{class => 'LimitedPolynomial::Function::numeric'}
286 ); 345 );
287} 346}
347foreach ('sin','cos','tan','sec','csc','cot',
348 'asin','acos','atan','asec','acsc','acot') {
349 $context{LimitedPolynomial}->functions->set(
350 "$_"=>{class => 'LimitedPolynomial::Function::trig'},
351 "${_}h"=>{class => 'LimitedPolynomial::Function::hyperbolic'}
352 );
353}
288 354
289Context("LimitedPolynomial"); 355Context("LimitedPolynomial");

Legend:
Removed from v.4121  
changed lines
  Added in v.4298

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9