#!/usr/bin/perl -w

package Poly;

use overload 
    '+'=>\&add,
    '-'=>\&subtract,
    '*'=>\&multiply,
    neg=>\&negate,
    '""'=>\&tostring,
    ;
    

sub new {
    shift;my $p=shift || {};
    if (!ref($p)) {
	my $var=shift || 'x';
	my @i=split /((?<!\^)[+-])/,$p;
	$p={};
	print join(',',@i);
	do {{
	    my ($a,$b)=@i[-2..-1];
	    next if (!$a && !$b);
	    my $e=0;
	    $e=$2 || 1 if $b=~s/\Q$var\E(\^(.+))?//;
	    $e=-$e if $b=~s'/'';
	    $b||=1;
	    $b=sprintf("%g",$b);
	    $b=-$b if $a && $a=~/-/;
	    $p->{$e}=$b||1;
	}} while (($#i-=2)>=0);
    }
    return clean(bless $p);
}

sub tostring {
    my $p=shift;
    my $var=shift ||'x';

    if (!%$p) {
	'0'; # special case
    } else {
	my $s='';
	my $f;

	for (grep {$p->{$_}} sort{$b<=>$a} keys %$p) {
	    my ($e,$v)=($_,$p->{$_});
	    $s.='+' if ($s && $v>=0); # not ne as zero handled above
	    if ($_<0) {
		$s.="$v/", $e=-$e; 
	    } else {
		!$_ || $v!=1 and $s.=$v==-1?'-':$v;
	    }
	    $e and $s.=($e==1 ? $var : "$var^$e");
	}

	$s;
    }

}

sub add {
    my ($p, $q)=@_;
    local $^W=0; # for undef
    my $r=new();
    # inefficient
    $r->{$_}=$p->{$_}+$q->{$_} or delete $r->{$_} for (sort (keys %$p,keys %$q));
    $r;
}

sub negate {
    (undef,my $r)=@_;
    $r->{$_}=-$r->{$_} for keys %$r;
    $r;
}

sub subtract {
    (undef, my $p, my $q)=@_;
    add($p,negate($q));
}

sub multiply {
    my ($p,$q)=@_;
    my $r=new();
    for my $a (keys %$p) {
	for my $b (keys %$q) {
	    $r->{$a+$b}+=$p->{$a}*$q->{$b};
	}
    }
    clean($r);
}

sub solve {
    my $p=shift;
    return 0 if (keys %$p==0);

    if (keys %$p<3) {
	my ($e,$v)=each %$p;
	my ($e2,$v2)=(each %$p, 0,0);
	return ((-($v2/$v))**(1/($e-$e2)));
    }

    die "Polynomial too hard to solve";
}

sub eval {
    my ($p,$v)=@_;
    my $r=0;
    for (keys %$p) {
	$r+=$p->{$_}*$v**$_;
    }
    $r;
}

sub clean {
    # eliminate zeros
    my ($p)=shift;
    while (my @a=each %$p) {
	delete $p->{$a[0]} if !$a[1];
    }
    $p;
}

1;

=head1 NAME

Poly - class for manipulation of polynomials

=head1 SYNOPSIS

    use Poly;

    my $a=new Poly '3x^2+x+4';
    my $b=new Poly '2-5x';

    print join "\n", $a, $b, $a+$b, $a-$b, $a*$b;


    my $c=new Poly '3.5-1/y^2', 'y';
    print join "\n", $c, $c->solve, $c->eval($c->solve);

    my $d=new Poly {
	            2 => 5,
	            1 =>-7,
	            0 => 2,
		   };
    print $d;

=head1 DESCRIPTION

Nah.

=head1 BUGS

Yep.

=head1 AUTHOR

Tom Hargreaves <hex@freezone.co.uk>

=cut