1#!/usr/bin/perl
2
3#  Opp.pm - A perl representation mathematicall expressions.
4#  (c) Copyright 1998 Hakan Ardo <hakan@debian.org>
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  You should have received a copy of the GNU General Public License
17#  along with this program; if not, write to the Free Software
18#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
20=head1 NAME
21
22  Math::Expr::Opp - Represents one operation in the parsed expression
23                    tree
24
25=head1 SYNOPSIS
26
27  require Math::Expr::Opp;
28  require Math::Expr::Var;
29  require Math::Expr::Num;
30
31  # To represent the expression "x+7":
32  $n=new Math::Expr::Opp("+");
33  $n->SetOpp(0,new Math::Expr::Var("x"));
34  $n->SetOpp(1,new Math::Expr::Num(7));
35  print $n->tostr . "\n";
36
37=head1 DESCRIPTION
38
39  Used by the Math::Expr to represent algebraic expressions. This class
40  represents one operation or function with a set of operands, which
41  in turn can be other Math::Expr::Opp objects. And in that way we are
42  able to represent entire expression.
43
44  Operations like a+b and functions like sin(a) or f(a,b) are all
45  represented by this kind of objects with "+", "sin" and "f" as the
46  operation- or function names and Math::Expr::Var(a) and
47  Math::Expr::Var(b) as operands (only a in the sin example).
48
49=head1 METHODS
50
51=cut
52
53package Math::Expr::Opp;
54use strict;
55
56use Math::Expr qw ($Pri $OppDB);
57require Math::Expr::MatchSet;
58require Math::Expr::Node;
59require Math::Expr::VarSet;
60use vars qw(@ISA);
61
62use Math::Expr::Node;
63@ISA = qw(Math::Expr::Node);
64
65=head2 $e=new  Math::Expr::Opp($name,$db)
66
67  Creates a new operation object with the operation- or function-name
68  $name. Using the operations defined in $db. See
69  L<Math::Expr::OpperationDB> for more info.
70
71=cut
72
73sub new {
74	my($class, $val) = @_;
75	my $self = bless { }, $class;
76
77  if (!ref $OppDB || !ref $Pri) {
78    warn "OppDB not initiated, please set it using SetOppDB(...)";
79  }
80
81	$self->{'Val'}=$val;
82	$self->Breakable(0);
83
84	$self;
85
86}
87
88=head2 $e->SetOpp($i, $v)
89
90  Sets operand number $i to $v.
91
92=cut
93
94sub SetOpp {
95	my ($self, $i, $val) = @_;
96
97	# Sanity checks
98	defined $i || warn "Bad param i.";
99	$val->isa("Math::Expr::Node") || warn "Bad param val: $val";
100	!$self->InTable || warn "Can't edit items in the table";
101
102	delete $self->{'Op'};
103
104	$self->{'Opps'}[$i]=$val;
105}
106
107=head2 $e->Opp($i)
108
109  Returns operand to number $i.
110
111=cut
112
113sub Opp {
114	my ($self, $i) = @_;
115
116	# Sanity checks
117	defined $i || warn "Bad param i.";
118
119	$self->{'Opps'}[$i];
120}
121
122=head2 $e->tostr
123
124  Returns a string representation of the entire expression to be
125  used for debugging.
126
127=cut
128
129sub tostr {
130	my $self = shift;
131	my $str=$self->{'Val'}."(";
132	my $i;
133
134  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
135    if (ref $self->{'Opps'}[$i]) {
136			$str .= $self->{'Opps'}[$i]->tostr;
137		} else {
138			$str .= "?";
139		}
140    if ($i+1<=$#{$self->{'Opps'}}) {
141      $str .= ",";
142		}
143	}
144  "$str)";
145}
146
147=head2 $e->strtype
148
149  Returns a string representation of this expressions entire type,
150  without simplifying it. In the same notation as the tostr method.
151
152=cut
153
154sub strtype {
155	my $self = shift;
156	my $str=$self->{'Val'}."(";
157	my $i;
158
159  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
160    $str .= $self->{'Opps'}[$i]->strtype;
161    if ($i+1<=$#{$self->{'Opps'}}) {
162      $str .= ",";
163		}
164	}
165  "$str)";
166}
167
168=head2 $n->Simplify
169
170  Simplifys the expression to some normal from.
171
172=cut
173
174sub op {
175	my ($self, $force)=@_;
176	if ($force || !$self->{'Op'}) {
177		$self->{'Op'}=$OppDB->Find($self->DBType);
178	}
179	return $self->{'Op'};
180}
181
182sub Simplify {
183  my ($self)=@_;
184	my $i;
185	my $op;
186
187  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
188		$self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Simplify;
189  }
190
191	$op=$self->op(1);
192
193	# Type specific simplification rules
194	if ($op->{'simp'}) {
195		my $vs=new Math::Expr::VarSet;
196
197		for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
198			$vs->Set(chr(97+$i), $self->{'Opps'}[$i]);
199		}
200#		print $vs->tostr  . "\n";
201
202		my $e=$op->{'simp'}->Copy;
203		$e=$e->Subs($vs);
204
205#		print $e->tostr  . "\n";
206
207		foreach (keys %{$e}) {
208			$self->{$_}=$e->{$_};
209		}
210		$op=$self->op(1);
211	}
212
213	# (a+b)+c => a+b+c
214  if ($op->{'ass'}) {
215		my @nopp;
216    for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
217      if ($self->{'Val'} eq $self->{'Opps'}[$i]{'Val'}) {
218        foreach (@{$self->{'Opps'}[$i]{'Opps'}}) {
219          push(@nopp, $_);
220        }
221      } else {
222        push (@nopp, $self->{'Opps'}[$i]);
223      }
224    }
225    $self->{'Opps'}=\@nopp;
226  }
227
228	# a+c+b => a+b+c
229  if ($op->{'com'}) {
230		my @nopp = sort {$a->tostr cmp $b->tostr} @{$self->{'Opps'}};
231		$self->{'Opps'}=\@nopp;
232	}
233	delete $self->{'Op'};
234	return $self->IntoTable;
235}
236
237
238=head2 $n->BaseType
239
240  Returns a string type of this expression simplifyed as much as
241  possible.
242
243=cut
244
245sub BaseType {
246  my ($self)=@_;
247	my $op;
248	my $str=$self->DBType;
249
250	$op= $self->op;
251	if ($op) {$str=$op->{'out'}}
252
253	$str;
254}
255
256sub DBType {
257  my ($self)=@_;
258	my $str=$self->{'Val'}."(";
259	my $i;
260
261  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
262    $str .= $self->{'Opps'}[$i]->BaseType;
263    if ($i+1<=$#{$self->{'Opps'}}) {
264      $str .= ",";
265		}
266	}
267  "$str)";
268}
269
270sub power {
271  my ($a, $b) = @_;
272  my $i;
273  my $sum=1;
274
275  for ($i=0; $i<$b; $i++) {
276    $sum=$sum*$a
277  }
278  $sum;
279}
280
281=head2 $n->SubMatch($rules,$match)
282
283  Tries to match $rules to this expretions and adds the substitutions
284  needed to $match.Returns 1 if the match excists and the substitutions
285  needed can coexcist with those already in $match otherwise 0.
286
287=cut
288
289sub _SubMatch {
290  my ($self, $rule, $mset) = @_;
291	my $op=$self->op;
292
293	$self->InTable || warn "self not in table!";
294	$rule->InTable || warn "rule not in table!";
295
296	if ($rule->isa('Math::Expr::Var') &&
297			$rule->BaseType eq $self->BaseType
298		 ) {
299		return $mset->SetAll($rule->{'Val'},$self);
300  }
301  elsif ($rule->isa('Math::Expr::Opp') &&
302				 $rule->{'Val'} eq $self->{'Val'}) {
303		if ($op->{'ass'}) {
304			if ($op->{'com'}) {
305				my @part;
306				my @pcnt;
307				my ($i,$j,$cnt);
308				my $p=$#{$rule->{'Opps'}} + 1;
309				my $s=$#{$self->{'Opps'}} + 1;
310				my $ps=power($p,$s) - 1;
311				my $resset = new Math::Expr::MatchSet;
312				my $m;
313				my $t;
314				my $a;
315				my $ok;
316
317				for ($i=1; $i<$ps; $i++) {
318					for ($j=0; $j<$p; $j++) {
319						$part[$j]=new Math::Expr::Opp($self->{'Val'});
320						$pcnt[$j]=0;
321					}
322					$cnt=0;
323
324					$t=$i;
325					for ($j=0; $j<$s; $j++) {
326						$a= $t % $p;
327						$part[$a]->{'Opps'}[$pcnt[$a]]=$self->{'Opps'}[$cnt];
328						$pcnt[$a]++;
329						$cnt++;
330            $t=int($t/$p);
331					}
332
333          $a=1;
334					for ($j=0; $j<$p; $j++) {
335#						print $part[$j]->tostr . "\t";
336            if (!defined $part[$j]->{'Opps'}[0]) {$a=0; last;}
337            if (!defined $part[$j]->{'Opps'}[1]) {
338              $part[$j]=$part[$j]->{'Opps'}[0];
339            }
340						$part[$j]=$part[$j]->IntoTable;
341          }
342#					print "\n";
343
344          if ($a) {
345            $m=$mset->Copy;
346            $m->AddPos("($i)");
347#						print "m:\n" . $m->tostr . "\n";
348						$ok=1;
349  					for ($j=0; $j<$p; $j++) {
350							my $t=$part[$j]->SubMatch($rule->{'Opps'}[$j],$m);
351              if (!$t) {
352								$ok=0;
353							}
354            }
355            if ($ok) {$resset->Insert($m);}
356          }
357				}
358
359#				print "res:\n" . $resset->tostr . "\n";
360
361        $mset->Clear;
362        $mset->Insert($resset);
363				return 1;
364			} else {
365        #FIXME: Handle ass only objs...
366			}
367		}
368		elsif ($#{$self->{'Opps'}} eq $#{$rule->{'Opps'}}) {
369			my $ok=1;
370			my $i;
371
372			for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
373				if (!$self->{'Opps'}[$i]->SubMatch($rule->{'Opps'}[$i],$mset)) {
374					$ok=0;
375					last;
376				}
377			}
378			return $ok;
379		} else {
380			return 0;
381		}
382	} else {
383		return 0;
384	}
385}
386
387=head2 $n->Match($rules)
388
389  Tries to match $rules to this expretions and to all its subexpretions.
390  Returns a MatchSet object specifying where the matches ocored and what
391  substitutions they represent.
392
393=cut
394
395sub _Match {
396  my ($self, $rule, $pos, $pre) = @_;
397	my $i;
398	my $mset = new Math::Expr::MatchSet;
399	my $op=$self->op;
400
401	$self->InTable || warn "self not in table!";
402	$rule->InTable || warn "rule not in table!";
403
404	if (!defined $pos) {$pos="";}
405	if (!defined $pre) {$pre=new Math::Expr::VarSet}
406
407	$mset->Set($pos, $pre->Copy);
408	if (!$self->SubMatch($rule, $mset)) {
409		$mset->del($pos);
410	}
411
412	if ($pos ne "") {$pos .=","}
413
414	for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
415		my $m=$self->SubExpr($i)->IntoTable->Match($rule, "$pos$i", $pre->Copy);
416		$mset->Insert($m);
417	}
418
419	$mset;
420}
421
422sub SubOpp {
423  my ($self, $a,$b) = @_;
424  my $i;
425  my $o= new Math::Expr::Opp($self->{'Val'});
426
427	# Sanity checks
428	defined $a|| warn("Bad param a.");
429	defined $b|| warn("Bad param b.");
430
431  if ($a==$b) {return $self->{'Opps'}[$a]}
432
433  for ($i=$a; $i<=$b; $i++) {
434    $o->SetOpp($i-$a,$self->{'Opps'}[$i]);
435  }
436  return $o->IntoTable;
437}
438
439=head2 $n->Subs($vars)
440
441  Substitues all variables in the expretion with there vaules in $vars.
442
443=cut
444
445sub _Subs {
446	my ($self, $vars) = @_;
447	my $i;
448	my $n = new Math::Expr::Opp($self->{'Val'});
449
450  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
451		$n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Subs($vars);
452	}
453	$n;
454}
455
456=head2 $n->Copy
457
458Returns a copy of this object.
459
460=cut
461
462sub _Copy {
463	my $self = shift;
464	my $n = new Math::Expr::Opp($self->{'Val'});
465	my $i;
466
467  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
468		$n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Copy;
469	}
470	$n;
471}
472
473=head2 $n->Breakable
474
475  Used by the parser to indikate if this object was created using
476  parantesis or if he should break it up to preserve the rules of order
477  between the diffrent opperations.
478
479=cut
480
481sub _Breakable {
482  my $self=shift;
483  my $val=shift;
484
485  if (defined $val) {$self->{'Breakable'}=$val}
486  $self->{'Breakable'}
487}
488
489=head2 $n->Find($pos)
490
491  Returns an object pointer to the subexpression represented by the
492  string $pos.
493
494=cut
495
496sub Find {
497  my ($self, $pos) = @_;
498
499	# Sanity checks
500	defined $pos || warn "Bad param pos.";
501
502  if ($pos =~ s/^(\d+),?//) {
503		return $self->SubExpr($1)->Find($pos);
504  } else {
505    return $self;
506  }
507}
508
509sub SubExpr {
510  my ($self, $pos, $rest) = @_;
511	my $op=$self->op;
512
513	# Sanity checks
514	defined $pos || warn "Bad param pos.";
515	if (ref $rest) {
516		$rest->isa("Math::Expr::Opp") || warn "Bad param rest: $rest";
517		!$rest->InTable || warn "Can't edit items in the table";
518	}
519  elsif(defined  $rest) {
520    warn "Bad param rest: $rest";
521  }
522
523	if ($op->{'ass'} && $op->{'com'}) {
524		my ($part, $j);
525		my $cnt=0;
526    my $rcnt=0;
527
528    $part=new Math::Expr::Opp($self->{'Val'});
529
530		for($j=0; $j<=$#{$self->{'Opps'}}; $j++) {
531		  if ($j!=$pos) {
532				$part->{'Opps'}[$cnt]=$self->{'Opps'}[$j];
533				$cnt++;
534			}
535      elsif(ref $rest) {
536        $rest->{'Opps'}[$rcnt]=$self->{'Opps'}[$j];
537        $rcnt++;
538      }
539		}
540
541    if (!defined $part->{'Opps'}[1]) {$part=$part->{'Opps'}[0];}
542    return $part; #->IntoTable;
543  } else {
544    return $self->{'Opps'}[$pos];
545  }
546}
547
548=head2 $n->Set($pos, $val)
549
550  Replaces the subexpression at position $pos with $val.
551
552=cut
553
554sub _Set {
555  my ($self, $pos, $val) = @_;
556	my $op=$self->op;
557
558	$pos =~ s/\(\d+\)//g;
559
560	if ($pos eq "") {
561		return $val;
562	} else {
563		$pos =~ s/^(\d+),?//;
564		my $i=$1;
565
566		if ($op->{'ass'} && $op->{'com'}) {
567			my $rest=new Math::Expr::Opp($self->{'Val'});
568	    my $part=$self->SubExpr($i, $rest)->Set($pos,$val);
569			my $n=new Math::Expr::Opp($self->{'Val'});
570
571			if (!defined $rest->{'Opps'}[1]) {$rest=$rest->{'Opps'}[0];}
572
573			$n->{'Opps'}[0]=$rest;
574			$n->{'Opps'}[1]=$part;
575			return $n;
576		} else {
577			$self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Set($pos,$val);
578		}
579    return $self;
580	}
581}
582
583sub _toMathML {
584	my $self = shift;
585	my @p;
586	my $i;
587	my $op = $self->op;
588
589  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
590		$p[$i]=$self->{'Opps'}[$i]->toMathML;
591		if (!defined $op->{'noparammathml'} || !eval($op->{'noparammathml'})) {
592			if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) {
593				if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) {
594					if (defined $Pri->{$self->{'Val'}} &&
595							defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) {
596						if ($Pri->{$self->{'Val'}} >=
597								$Pri->{$self->{'Opps'}[$i]{'Val'}}) {
598							$p[$i]='<mrow><mo fence="true">(</mo>'.$p[$i].
599								'<mo fence="true">)</mo></mrow>';
600						}
601					}
602				}
603			}
604		}
605	}
606
607	if (defined $op->{'prmathml'}) {
608		eval($op->{'prmathml'});
609	} else {
610		if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) {
611			 "<mrow>".join ("<mo>".$self->{'Val'}."</mo>", @p)."</mrow>";
612		} else {
613			'<mrow><mi fontstyle="normal">'.$self->{'Val'}.'</mi>'.
614				'<mo fence="true">(</mo>'.join (", ", @p) . "".
615				'<mo fence="true">)</mo></mrow>'
616		}
617	}
618}
619
620sub toText {
621	my $self = shift;
622	my @p;
623	my $i;
624	my $op =	$self->op;
625
626  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
627		$p[$i]=$self->{'Opps'}[$i]->toText;
628		if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) {
629			if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) {
630				if (defined $Pri->{$self->{'Val'}} &&
631						defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) {
632					if ($Pri->{$self->{'Val'}} >=
633							$Pri->{$self->{'Opps'}[$i]{'Val'}}) {
634						$p[$i]='('.$p[$i].')';
635					}
636				}
637			}
638		}
639	}
640
641  if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) {
642		join ($self->{'Val'}, @p);
643	} else {
644		$self->{'Val'}.'('.join (", ", @p).')'
645	}
646}
647
648=head1 AUTHOR
649
650  Hakan Ardo <hakan@debian.org>
651
652=head1 SEE ALSO
653
654  L<Math::Expr>
655
656=cut
657
6581;
659