File Coverage

blib/lib/Math/Expr/Rule.pm

Criterion	Covered	Total	%
statement	29	41	70.7
branch	4	6	66.6
condition			n/a
subroutine	3	5	60.0
pod	0	4	0.0
total	36	56	64.2

#!/usr/bin/perl

#  Rule.pm - Represents a agebraic rule
#  (c) Copyright 1998 Hakan Ardo
#
#  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::Var - Represents a agebraic rule

=head1 SYNOPSIS

  reuire Math::Expr::Var;
  reuire Math::Expr;

	$r=new Math::Expr::Var($from, $to);
  @res=$r->Apply($expr)

=head1 DESCRIPTION

  This will create a rule that converts the expression $from to $to,
  and then apply that rule to $expr. $from, $to, $expr are all
  Math::Expr::Opp structures that should be Simplified to work ok.

  The result is a array @res of Math::Expr::Opp objects which should
  contain the results of applying the rule once on $expr in all
  possible ways. They are all simplified, and duplicaions are removed.

=head1 METHODS

=cut

package Math::Expr::Rule;
use strict;

=head2 	$r=new Math::Expr::Var($from, $to);

  Makes a rule converting the Math::Expr::Opp structur $from into $to.

=cut

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

	$self->{'From'}=$from;
	$self->{'To'}=$to;

	$self;
}

sub Apply {
	my ($self, $expr, $pre)=@_;
	my $e=$expr;
	my $ms=$e->Match($self->{'From'}, "", $pre);
	my ($n,$nh);
	my @res;
	my ($ok, $t);
	my $id=[];

	foreach ($ms->Keys) {
		$n=$e->Copy;
		$nh=$self->{'To'}->Subs($ms->Get($_));
		$n=$n->Set($_,$nh);
		$n->Simplify;

		$ok=1;
		foreach $t (@res) {
			if ($t->tostr eq $n->tostr) {$ok=0; last;}
		}
		if ($ok) {
			push @res,$n;
			push @{$id}, $_;

		}
	}
	$self->{'Id'}=$id;
	@res;
}

sub ApplyAt {
	my ($self, $e, $pos, $pre) = @_;
	my $i;
	my @r=$self->Apply($e, $pre);

	for ($i=0; $i<=$#r; $i++) {
		if ($self->{'Id'}[$i] eq $pos) {
			return $r[$i];
		}
	}
	warn "Unable to apply at that position";
	return 0;
}

sub GetId {
	my $self=shift;
	$self->{'Id'};
}

1;