File Coverage

blib/lib/Math/Expr/FormulaDB.pm

Criterion	Covered	Total	%
statement	6	101	5.9
branch	0	26	0.0
condition	0	9	0.0
subroutine	2	11	18.1
pod	0	9	0.0
total	8	156	5.1

#!/usr/bin/perl

#  FormulaDB.pm - A db of formulas and there properties
#  (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::FormulaDB - A db of formulas and there properties

=head1 SYNOPSIS

  require Math::Expr::FormulaDB;
  $db=new Math::Expr::FormulaDB($file);

=cut

package Math::Expr::FormulaDB;
use strict;
use Math::Expr;

require Math::Expr::Rule;

sub new {
  my $self = bless {}, shift;
  $self->Load(shift);
	my $db;
	my ($vl, $hl);

	foreach ($self->Keys) {
    $db=$self->Get($_);
		$vl=Parse($db->{'vl'}); $vl=$vl->Simplify;
		$hl=Parse($db->{'hl'}); $hl=$hl->Simplify;

		$db->{'for'}= new Math::Expr::Rule($vl, $hl);
		$db->{'back'}= new Math::Expr::Rule($hl, $vl);
	}

  $self;
}

sub Load {
  my ($self, $file) = @_;

  if (-f $file) {$self->LoadFile($file);}
  if (-d $file) {$self->LoadDir($file);}
}
sub LoadFile {
  my ($self, $file) = @_;
  my %t;

  open (F, "<$file");
  while () {
    if (/^([^:]+)\s*:\s*(.*)$/) {
			my  $a=lc($1);
			if (defined $t{$a}) {$t{$a}.="\n$2";} else {$t{$a}=$2;}
		}
    if (/^\s*$/ || eof F) {
      if ($t{'name'}) {
				my $t=$t{'name'};
				delete $t{'name'};

				foreach (keys %t) {
					$self->{'opps'}{$t}{$_}=$t{$_};
          delete $t{$_};
				}
      }
    }
  }
}

sub LoadDir {
  my ($self, $dir) = @_;

  foreach (split(/\n/s, `find $dir -type f`)) {
    next if (/~$/);
    $self->LoadFile($_);
  }
}

sub Keys {
	my $self = shift;

	keys %{$self->{'opps'}};
}

sub Get {
	my ($self, $a) = @_;

	$self->{'opps'}{$a};
}

sub Find {
  my ($self, $e, $t) = @_;
  my $db;
  my ($n, $d, $i);
  my (@res, $id);
  my $r;

	if (!defined $t) {$t=0;}

  foreach $n ($self->Keys) {
    $db=$self->Get($n);
		foreach $d ("for", "back") {
			if (!$t || !$db->{'triv'.$d}) {
				@res=$db->{$d}->Apply($e);
				$id=$db->{$d}->GetId;
				for ($i=0; $i<=$#res; $i++) {
					$r->{"$n-$d-".$id->[$i]}=$res[$i];
				}
			}
		}
  }
  $r;
}

sub ApplyProof {
	my ($self, $key) = @_;
	my %vars;
	my $db=$self->Get($key);
	my $res="";
	my $prev="";

	if (defined $db->{'b'}) {
		$vars{'vl'}=Parse($db->{'vl'});
		$vars{'hl'}=Parse($db->{'hl'});

		$res.=$vars{'hl'}->toText;
		$vars{'hl'}->Simplify;
		$res.=" <=> ".$vars{'hl'}->toText."\n";

		$res.=$vars{'vl'}->toText;
		$vars{'vl'}->Simplify;
		$res.=" <=> " . $vars{'vl'}->toText;
		$prev="vl";

		foreach (split(/\n/s, $db->{'b'})) {
			if (/^\s*\$([^\s=]+)\s*=\s*([^\'\s]*)\s*(\'[^\']+\')?$/) {
				my $var=$1; my $rule=$2; my $pre=$3;
				if (defined $pre && $pre=~/^\s*\'\s*([^=\s]+)\s*=\s*([^\']+)\'\s*$/) {
					my $a=$1; my $b=$2;
					print "Pre: $a<=>$b\n";
					$pre=new Math::Expr::VarSet;
					$pre->Set($a, Parse($b));
				} else {
					$pre=undef;
				}

				if ($prev ne $var) {$res.="\n".$vars{$var}->toText;}
				$vars{$var}=$self->ApplyAt($vars{$var},$rule,$pre);
				$res.=" <=> " . $vars{$var}->toText;
				$prev=$var;
			}
		}
		$res."\n";
	}
}

sub ApplyAt {
	my ($self, $e, $r,$pre) = @_;
	my ($rule, $dir, $pos) = split (/-/, $r);

	$self->Get($rule)->{$dir}->ApplyAt($e,$pos,$pre);
}

1;