ports//math/p5-Math-Expr/work/Math-Expr-0.4/Expr/Opp.pm

#!/usr/bin/perl 

#  Opp.pm - A perl representation mathematicall expressions.
#  (c) Copyright 1998 Hakan Ardo <hakan@debian.org>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  any later version.
#  
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

=head1 NAME

  Math::Expr::Opp - Represents one operation in the parsed expression 
                    tree

=head1 SYNOPSIS

  require Math::Expr::Opp;
  require Math::Expr::Var;
  require Math::Expr::Num;
  
  # To represent the expression "x+7":
  $n=new Math::Expr::Opp("+");
  $n->SetOpp(0,new Math::Expr::Var("x"));
  $n->SetOpp(1,new Math::Expr::Num(7));
  print $n->tostr . "\n";

=head1 DESCRIPTION

  Used by the Math::Expr to represent algebraic expressions. This class 
  represents one operation or function with a set of operands, which 
  in turn can be other Math::Expr::Opp objects. And in that way we are 
  able to represent entire expression.

  Operations like a+b and functions like sin(a) or f(a,b) are all 
  represented by this kind of objects with "+", "sin" and "f" as the
  operation- or function names and Math::Expr::Var(a) and 
  Math::Expr::Var(b) as operands (only a in the sin example).

=head1 METHODS

=cut

package Math::Expr::Opp;
use strict;

use Math::Expr qw ($Pri $OppDB);
require Math::Expr::MatchSet;
require Math::Expr::Node;
require Math::Expr::VarSet;
use vars qw(@ISA);

use Math::Expr::Node;
@ISA = qw(Math::Expr::Node);

=head2 $e=new  Math::Expr::Opp($name,$db)

  Creates a new operation object with the operation- or function-name 
  $name. Using the operations defined in $db. See 
  L<Math::Expr::OpperationDB> for more info.

=cut

sub new {
	my($class, $val) = @_;
	my $self = bless { }, $class;

  if (!ref $OppDB || !ref $Pri) {
    warn "OppDB not initiated, please set it using SetOppDB(...)";
  }

	$self->{'Val'}=$val;
	$self->Breakable(0);

	$self;

}

=head2 $e->SetOpp($i, $v)

  Sets operand number $i to $v.

=cut

sub SetOpp {
	my ($self, $i, $val) = @_;

	# Sanity checks
	defined $i || warn "Bad param i.";
	$val->isa("Math::Expr::Node") || warn "Bad param val: $val";
	!$self->InTable || warn "Can't edit items in the table";

	delete $self->{'Op'};

	$self->{'Opps'}[$i]=$val;
}

=head2 $e->Opp($i)

  Returns operand to number $i.

=cut

sub Opp {
	my ($self, $i) = @_;

	# Sanity checks
	defined $i || warn "Bad param i.";

	$self->{'Opps'}[$i];
}

=head2 $e->tostr

  Returns a string representation of the entire expression to be 
  used for debugging.

=cut

sub tostr {
	my $self = shift;
	my $str=$self->{'Val'}."(";
	my $i;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
    if (ref $self->{'Opps'}[$i]) {
			$str .= $self->{'Opps'}[$i]->tostr;
		} else {
			$str .= "?";
		}
    if ($i+1<=$#{$self->{'Opps'}}) {
      $str .= ",";
		}
	}
  "$str)";
}

=head2 $e->strtype

  Returns a string representation of this expressions entire type, 
  without simplifying it. In the same notation as the tostr method.

=cut

sub strtype {
	my $self = shift;
	my $str=$self->{'Val'}."(";
	my $i;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
    $str .= $self->{'Opps'}[$i]->strtype;
    if ($i+1<=$#{$self->{'Opps'}}) {
      $str .= ",";
		}
	}
  "$str)";
}

=head2 $n->Simplify

  Simplifys the expression to some normal from.

=cut

sub op {
	my ($self, $force)=@_;
	if ($force || !$self->{'Op'}) {
		$self->{'Op'}=$OppDB->Find($self->DBType);
	}
	return $self->{'Op'};
}

sub Simplify {
  my ($self)=@_;
	my $i;
	my $op;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		$self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Simplify;
  }

	$op=$self->op(1);

	# Type specific simplification rules
	if ($op->{'simp'}) {
		my $vs=new Math::Expr::VarSet;

		for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
			$vs->Set(chr(97+$i), $self->{'Opps'}[$i]);
		}
#		print $vs->tostr  . "\n";

		my $e=$op->{'simp'}->Copy;
		$e=$e->Subs($vs);

#		print $e->tostr  . "\n";

		foreach (keys %{$e}) {
			$self->{$_}=$e->{$_};
		}
		$op=$self->op(1);
	}

	# (a+b)+c => a+b+c
  if ($op->{'ass'}) {
		my @nopp;
    for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
      if ($self->{'Val'} eq $self->{'Opps'}[$i]{'Val'}) {
        foreach (@{$self->{'Opps'}[$i]{'Opps'}}) {
          push(@nopp, $_);
        }
      } else {
        push (@nopp, $self->{'Opps'}[$i]);
      }
    }
    $self->{'Opps'}=\@nopp;
  }

	# a+c+b => a+b+c
  if ($op->{'com'}) {
		my @nopp = sort {$a->tostr cmp $b->tostr} @{$self->{'Opps'}};
		$self->{'Opps'}=\@nopp;
	}
	delete $self->{'Op'};
	return $self->IntoTable;
}


=head2 $n->BaseType

  Returns a string type of this expression simplifyed as much as 
  possible.

=cut

sub BaseType {
  my ($self)=@_;
	my $op;
	my $str=$self->DBType;

	$op= $self->op;
	if ($op) {$str=$op->{'out'}}

	$str;
}

sub DBType {
  my ($self)=@_;
	my $str=$self->{'Val'}."(";
	my $i;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
    $str .= $self->{'Opps'}[$i]->BaseType;
    if ($i+1<=$#{$self->{'Opps'}}) {
      $str .= ",";
		}
	}
  "$str)";
}

sub power {
  my ($a, $b) = @_;
  my $i;
  my $sum=1;
  
  for ($i=0; $i<$b; $i++) {
    $sum=$sum*$a
  }
  $sum;
}

=head2 $n->SubMatch($rules,$match)

  Tries to match $rules to this expretions and adds the substitutions 
  needed to $match.Returns 1 if the match excists and the substitutions 
  needed can coexcist with those already in $match otherwise 0.

=cut

sub _SubMatch {
  my ($self, $rule, $mset) = @_;
	my $op=$self->op;

	$self->InTable || warn "self not in table!";
	$rule->InTable || warn "rule not in table!";

	if ($rule->isa('Math::Expr::Var') && 
			$rule->BaseType eq $self->BaseType
		 ) {
		return $mset->SetAll($rule->{'Val'},$self);
  }
  elsif ($rule->isa('Math::Expr::Opp') &&
				 $rule->{'Val'} eq $self->{'Val'}) {
		if ($op->{'ass'}) {
			if ($op->{'com'}) {
				my @part;
				my @pcnt;
				my ($i,$j,$cnt);
				my $p=$#{$rule->{'Opps'}} + 1;
				my $s=$#{$self->{'Opps'}} + 1;
				my $ps=power($p,$s) - 1;
				my $resset = new Math::Expr::MatchSet;
				my $m;
				my $t;
				my $a;
				my $ok;

				for ($i=1; $i<$ps; $i++) {
					for ($j=0; $j<$p; $j++) {
						$part[$j]=new Math::Expr::Opp($self->{'Val'});
						$pcnt[$j]=0;
					}
					$cnt=0;

					$t=$i;
					for ($j=0; $j<$s; $j++) {
						$a= $t % $p;
						$part[$a]->{'Opps'}[$pcnt[$a]]=$self->{'Opps'}[$cnt];
						$pcnt[$a]++;
						$cnt++;
            $t=int($t/$p);
					}

          $a=1; 
					for ($j=0; $j<$p; $j++) {
#						print $part[$j]->tostr . "\t";
            if (!defined $part[$j]->{'Opps'}[0]) {$a=0; last;}
            if (!defined $part[$j]->{'Opps'}[1]) {
              $part[$j]=$part[$j]->{'Opps'}[0];
            }
						$part[$j]=$part[$j]->IntoTable;
          }
#					print "\n";

          if ($a) {
            $m=$mset->Copy;
            $m->AddPos("($i)");
#						print "m:\n" . $m->tostr . "\n";
						$ok=1;
  					for ($j=0; $j<$p; $j++) {
							my $t=$part[$j]->SubMatch($rule->{'Opps'}[$j],$m);
              if (!$t) {
								$ok=0;
							}
            }
            if ($ok) {$resset->Insert($m);}
          }
				}

#				print "res:\n" . $resset->tostr . "\n";
        
        $mset->Clear;
        $mset->Insert($resset);
				return 1;
			} else {
        #FIXME: Handle ass only objs...
			}
		}
		elsif ($#{$self->{'Opps'}} eq $#{$rule->{'Opps'}}) {
			my $ok=1;
			my $i;
			
			for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
				if (!$self->{'Opps'}[$i]->SubMatch($rule->{'Opps'}[$i],$mset)) {
					$ok=0;
					last;
				}
			}
			return $ok;
		} else {
			return 0;
		}
	} else {
		return 0;
	}
}

=head2 $n->Match($rules)

  Tries to match $rules to this expretions and to all its subexpretions. 
  Returns a MatchSet object specifying where the matches ocored and what 
  substitutions they represent.

=cut

sub _Match {
  my ($self, $rule, $pos, $pre) = @_;
	my $i;
	my $mset = new Math::Expr::MatchSet;
	my $op=$self->op;

	$self->InTable || warn "self not in table!";
	$rule->InTable || warn "rule not in table!";

	if (!defined $pos) {$pos="";}
	if (!defined $pre) {$pre=new Math::Expr::VarSet}

	$mset->Set($pos, $pre->Copy);
	if (!$self->SubMatch($rule, $mset)) {
		$mset->del($pos);
	}

	if ($pos ne "") {$pos .=","}

	for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		my $m=$self->SubExpr($i)->IntoTable->Match($rule, "$pos$i", $pre->Copy);
		$mset->Insert($m);
	}

	$mset;
}

sub SubOpp {
  my ($self, $a,$b) = @_;
  my $i;
  my $o= new Math::Expr::Opp($self->{'Val'});

	# Sanity checks
	defined $a|| warn("Bad param a.");
	defined $b|| warn("Bad param b.");

  if ($a==$b) {return $self->{'Opps'}[$a]}

  for ($i=$a; $i<=$b; $i++) {
    $o->SetOpp($i-$a,$self->{'Opps'}[$i]);
  }
  return $o->IntoTable;
}

=head2 $n->Subs($vars)

  Substitues all variables in the expretion with there vaules in $vars.

=cut

sub _Subs {
	my ($self, $vars) = @_;
	my $i;
	my $n = new Math::Expr::Opp($self->{'Val'});

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		$n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Subs($vars);
	}
	$n;
}

=head2 $n->Copy

Returns a copy of this object.

=cut

sub _Copy {
	my $self = shift;
	my $n = new Math::Expr::Opp($self->{'Val'});
	my $i;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		$n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Copy;
	}
	$n;
}

=head2 $n->Breakable

  Used by the parser to indikate if this object was created using 
  parantesis or if he should break it up to preserve the rules of order 
  between the diffrent opperations.

=cut

sub _Breakable {
  my $self=shift;
  my $val=shift;

  if (defined $val) {$self->{'Breakable'}=$val}
  $self->{'Breakable'}
}

=head2 $n->Find($pos)

  Returns an object pointer to the subexpression represented by the 
  string $pos.

=cut

sub Find {
  my ($self, $pos) = @_;

	# Sanity checks
	defined $pos || warn "Bad param pos.";

  if ($pos =~ s/^(\d+),?//) {
		return $self->SubExpr($1)->Find($pos);
  } else {
    return $self;
  }
}

sub SubExpr {
  my ($self, $pos, $rest) = @_;
	my $op=$self->op;

	# Sanity checks
	defined $pos || warn "Bad param pos.";
	if (ref $rest) {
		$rest->isa("Math::Expr::Opp") || warn "Bad param rest: $rest";
		!$rest->InTable || warn "Can't edit items in the table";
	} 
  elsif(defined  $rest) {
    warn "Bad param rest: $rest";
  }

	if ($op->{'ass'} && $op->{'com'}) {
		my ($part, $j);
		my $cnt=0;
    my $rcnt=0;
			
    $part=new Math::Expr::Opp($self->{'Val'});

		for($j=0; $j<=$#{$self->{'Opps'}}; $j++) {
		  if ($j!=$pos) {
				$part->{'Opps'}[$cnt]=$self->{'Opps'}[$j];
				$cnt++;
			}
      elsif(ref $rest) {
        $rest->{'Opps'}[$rcnt]=$self->{'Opps'}[$j];
        $rcnt++;
      }
		}

    if (!defined $part->{'Opps'}[1]) {$part=$part->{'Opps'}[0];}
    return $part; #->IntoTable;
  } else {
    return $self->{'Opps'}[$pos];
  }
}

=head2 $n->Set($pos, $val)

  Replaces the subexpression at position $pos with $val.

=cut

sub _Set {
  my ($self, $pos, $val) = @_;
	my $op=$self->op;

	$pos =~ s/\(\d+\)//g;

	if ($pos eq "") {
		return $val;
	} else {
		$pos =~ s/^(\d+),?//;
		my $i=$1;

		if ($op->{'ass'} && $op->{'com'}) {
			my $rest=new Math::Expr::Opp($self->{'Val'});
	    my $part=$self->SubExpr($i, $rest)->Set($pos,$val);
			my $n=new Math::Expr::Opp($self->{'Val'});

			if (!defined $rest->{'Opps'}[1]) {$rest=$rest->{'Opps'}[0];}

			$n->{'Opps'}[0]=$rest;
			$n->{'Opps'}[1]=$part;
			return $n;
		} else {
			$self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Set($pos,$val);
		}
    return $self;
	}
}

sub _toMathML {
	my $self = shift;
	my @p;
	my $i;
	my $op = $self->op;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		$p[$i]=$self->{'Opps'}[$i]->toMathML;
		if (!defined $op->{'noparammathml'} || !eval($op->{'noparammathml'})) {
			if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) {
				if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) {
					if (defined $Pri->{$self->{'Val'}} &&
							defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) {
						if ($Pri->{$self->{'Val'}} >= 
								$Pri->{$self->{'Opps'}[$i]{'Val'}}) {
							$p[$i]='<mrow><mo fence="true">(</mo>'.$p[$i].
								'<mo fence="true">)</mo></mrow>';
						}
					}
				}
			}
		}
	}	

	if (defined $op->{'prmathml'}) {
		eval($op->{'prmathml'});
	} else {
		if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) {
			 "<mrow>".join ("<mo>".$self->{'Val'}."</mo>", @p)."</mrow>";
		} else {
			'<mrow><mi fontstyle="normal">'.$self->{'Val'}.'</mi>'.
				'<mo fence="true">(</mo>'.join (", ", @p) . "".
				'<mo fence="true">)</mo></mrow>'
		}
	}
}

sub toText {
	my $self = shift;
	my @p;
	my $i;
	my $op =	$self->op;

  for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) {
		$p[$i]=$self->{'Opps'}[$i]->toText;
		if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) {
			if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) {
				if (defined $Pri->{$self->{'Val'}} &&
						defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) {
					if ($Pri->{$self->{'Val'}} >= 
							$Pri->{$self->{'Opps'}[$i]{'Val'}}) {
						$p[$i]='('.$p[$i].')';
					}
				}
			}
		}
	}

  if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) {
		join ($self->{'Val'}, @p);
	} else {
		$self->{'Val'}.'('.join (", ", @p).')'
	}
}

=head1 AUTHOR

  Hakan Ardo <hakan@debian.org>

=head1 SEE ALSO

  L<Math::Expr>

=cut

1;
syntax highlighted by Code2HTML, v. 0.9.1