# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

BEGIN { $| = 1; print "Compilation 1..1\n"; }
END {print "not ok 1\n" unless $loaded;}

require Math::Expr::Rule;
require Math::Expr::FormulaDB;
use Math::Expr;
require Math::Expr::OpperationDB;

$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

$|=1;

$parse=[
			 ['a+b*c',
				'+(a:Real,*(b:Real,c:Real))',
				'a+b*c',
				'<math><mrow><mi>a</mi><mo>+</mo><mrow><mi>b</mi><mo>*</mo><mi>c</mi></mrow></mrow></math>'],
			 ['(a+b)*c',
				'*(+(a:Real,b:Real),c:Real)',
				'(a+b)*c',
				'<math><mrow><mrow><mo fence="true">(</mo><mrow><mi>a</mi><mo>+</mo><mi>b</mi></mrow><mo fence="true">)</mo></mrow><mo>*</mo><mi>c</mi></mrow></math>'],
			 ['a*b+c',
				'+(*(a:Real,b:Real),c:Real)',
				'a*b+c',
				'<math><mrow><mrow><mi>a</mi><mo>*</mo><mi>b</mi></mrow><mo>+</mo><mi>c</mi></mrow></math>'],
			 ['a*(b+c)',
				'*(a:Real,+(b:Real,c:Real))',
				'a*(b+c)',
				'<math><mrow><mi>a</mi><mo>*</mo><mrow><mo fence="true">(</mo><mrow><mi>b</mi><mo>+</mo><mi>c</mi></mrow><mo fence="true">)</mo></mrow></mrow></math>'],
			 ['1=a+b-c*d/a^d',
				'=(1,+(a:Real,-(b:Real,*(c:Real,/(d:Real,^(a:Real,d:Real))))))',
				'1=a+b-c*d/a^d',
				'<math><mrow><mn>1</mn><mo>=</mo><mrow><mi>a</mi><mo>+</mo><mrow><mi>b</mi><mo>-</mo><mrow><mi>c</mi><mo>*</mo><mfrac> <mi>d</mi> <msup><mrow><mi>a</mi></mrow><mi>d</mi></msup>  </mfrac></mrow></mrow></mrow></mrow></math>'],
			 ['1=a+b-c*(d/a)^d',
				'=(1,+(a:Real,-(b:Real,*(c:Real,^(/(d:Real,a:Real),d:Real)))))',
				'1=a+b-c*(d/a)^d',
				'<math><mrow><mn>1</mn><mo>=</mo><mrow><mi>a</mi><mo>+</mo><mrow><mi>b</mi><mo>-</mo><mrow><mi>c</mi><mo>*</mo><msup><mrow><mrow><mo fence="true">(</mo><mfrac> <mi>d</mi> <mi>a</mi>  </mfrac><mo fence="true">)</mo></mrow></mrow><mi>d</mi></msup></mrow></mrow></mrow></mrow></math>'],
			 ['1=a+b-c*sin(d)/a^d',
				'=(1,+(a:Real,-(b:Real,*(c:Real,/(sin(d:Real),^(a:Real,d:Real))))))',
				'1=a+b-c*sin(d)/a^d',
				'<math><mrow><mn>1</mn><mo>=</mo><mrow><mi>a</mi><mo>+</mo><mrow><mi>b</mi><mo>-</mo><mrow><mi>c</mi><mo>*</mo><mrow><mrow><mi fontstyle="normal">sin</mi><mo fence="true">(</mo><mi>d</mi><mo fence="true">)</mo></mrow><mo>/</mo><msup><mrow><mi>a</mi></mrow><mi>d</mi></msup></mrow></mrow></mrow></mrow></mrow></math>']];

print "Parse 0.." . $#{$parse} . "\n";

SetOppDB(new Math::Expr::OpperationDB('db/Opperations/Realtal'));

for ($i=0; $i<= $#{$parse}; $i++) {
	$e=Parse($parse->[$i][0]);
	$a=$e->tostr;
	$b=$e->toText;
	$c="<math>".$e->toMathML."</math>";
	if ($a eq $parse->[$i][1] && $b eq $parse->[$i][2] && $c eq $parse->[$i][3]){
		print "ok $i\n";
	} else {
		print "not ok $i\n";
	}
}

$rule = [
				 ['(a+b)*d','a*d+b*d','(a-b)*d',
					'+(*(a:Real,d:Real),*(d:Real,neg(b:Real)))'],
				 ['(i+j)*k','i*k+j*k','(a-b-c)*d',
					'+(*(+(a:Real,neg(b:Real)),d:Real),*(d:Real,neg(c:Real)))§§+(*(+(a:Real,neg(c:Real)),d:Real),*(d:Real,neg(b:Real)))§§+(*(+(neg(b:Real),neg(c:Real)),d:Real),*(a:Real,d:Real))'],

				 ['a*a','a^2','b*b','^(b:Real,2)'],
				 ['a*a','a^2','2*2','^(2,2)'],
				 ['a*a','a^2','(a+b)*(b+a)','^(+(a:Real,b:Real),2)'],
				 ['inv(c)*inv(d)', 'inv(a*b)', 'inv(a)*inv(b)*c', 
					'*(c:Real,inv(*(a:Real,b:Real)))'],
				 ['a','sqrt(a^2)','a*b',
					'*(a:Real,sqrt(^(b:Real,2)))§§sqrt(^(*(a:Real,b:Real),2))§§*(b:Real,sqrt(^(a:Real,2)))'],
				 ['a', 'sqrt(a^2)', 'inv(a)*inv(b)*c', 'c*sqrt((inv(a)*inv(b))^2)§§sqrt((c*inv(a)*inv(b))^2)§§inv(a)*sqrt((c*inv(b))^2)§§inv(b)*sqrt((c*inv(a))^2)§§c*inv(a)*inv(sqrt(b^2))§§c*inv(b)*inv(sqrt(a^2))§§c*inv(a)*sqrt(inv(b)^2)§§c*inv(b)*sqrt(inv(a)^2)§§inv(a)*inv(b)*sqrt(c^2)','txt'],
				 ['1', 'b/b', '1', '*(inv(q:Real),q:Real)','pre'],
				 ['1', 'b/b', 'a+b*1', 'b*inv(q)*q+a','pre','txt'],
				 ['a*b', 'a*b', 'a*b', '', 'pre'],
				];

print "Applying rules 0.." . $#{$rule} . "\n";

for ($i=0; $i<= $#{$rule}; $i++) {
	$f=Parse($rule->[$i][0]); $f=$f->Simplify;
	$t=Parse($rule->[$i][1]); $t=$t->Simplify;
	$e=Parse($rule->[$i][2]); $e=$e->Simplify;

	$r=new Math::Expr::Rule($f, $t);
	$str="";

	$pri=undef;
	if ($rule->[$i][4] eq 'pre') {
		$pri=new Math::Expr::VarSet;
		$pri->Set('b', new Math::Expr::Var('q'));
		$rule->[$i][4]=$rule->[$i][5];
	}

	foreach ($r->Apply($e,$pri)) {
		if ($rule->[$i][4] eq 'txt') {
			$str.='§§'.$_->toText;
		} else {
			$str.='§§'.$_->tostr;
		}
	}
	$str=~ s/^§§//;
#	print $str . "\n";

	if(comp($str,$rule->[$i][3])) {
		print "ok $i\n";
	} else {
		print "not ok $i\n";
	}
}

sub comp {
	my ($a, $b)=@_;
	my %t;
	my @a;

	foreach (split(/§§/, $a)) {
		$t{$_}=1;
	}

	foreach (split(/§§/, $b)) {
		if ($t{$_}) {
			delete $t{$_};
		} else {
			return 0;
		}
	}

	@a=keys %t;
	if ($#a>-1) {
		return 0;
	} else {
		return 1;
	}
}