package Math::Expression::Evaluator;
use strict;
use warnings;
use Math::Expression::Evaluator::Parser;
use Math::Expression::Evaluator::Util qw(is_lvalue simplify_ast);
#use Data::Dumper;
use Carp;

use Regexp::Common;
use Math::Trig qw(atan asin acos tan);

our $VERSION = '0.0.2';

=head1 NAME

Math::Expression::Evaluator - parses and evaluates mathematic expressions

=head1 SYNOPSIS

    use Math::Expression::Evaluator;
    my $m = new Math::Expression::Evaluator;

    print $m->parse("a = 12; a*3")->val(), "\n";
    # prints 36
    print $m->parse("2^(a/3)")->val(), "\n";
    # prints 8 (ie 2**3)
    print $m->parse("a / b")->val({ b => 6 }), "\n";
    # prints 36
    print $m->parse("log2(16)")->val(), "\n";
    # prints 4


=head1 DESCRIPTION

Math::Expression::Evaluator is a simple, recursive descending parser for 
mathematical expressions. It can handle normal arithmetics 
(includings powers ^), builtin functions like sin() and variables.

Multiple exressions can be seperated by whitespaces or by semicolons ';'. 
In case of multiple expressions the value of the last expression is 
returned.

Variables can be assigned with a single '=' sign, their name has to start 
with a alphabetic character or underscore C<[a-zA-Z_]>, and may contain 
alphabetic characters, digits and underscores.

Values for variables can also be provided as a hash ref as a parameter
to val(). In case of collision the explicitly provided value is used:

   $m->parse("a = 2; a")->val({a => 1}); 

will return 1, not 2.

The following builtin functions are supported atm:

=over 4

=item *

trignometric functions: sin, cos, tan

=item *

inverse trigonomic functions: asin, acos, atan

=item *

Square root: sqrt

=item * 

exponentials: exp, sinh, cosh

=item *

logarithms: log, log2, log10

=item * 

constants: pi() (you need the parenthesis to distinguish it from the 
variable pi)

=item *

other: theta (theta(x) = 1 for x > 0, theta(x) = 0 for x < 0)

=back

=head1 METHODS

=over 2

=item new

generates a new MathExpr object. accepts an optional argument, a hash ref
that contains configurations. If this hash sets force_semicolon to true, 
expressions have to be separated by a semicolon ';'.

=item parse

Takes a string as argument, and generates an AST that is stored internally.

Returns a reference to the object, so that method calls can be chained:

    print MathExpr->new->parse("1+2")->val;

Parse failures cause this method to die with a stack trace. 


=item val 

Executes the AST generated by parse(), and returns the number that the 
expression is evaluated to. It accepts an optional hash reference that
contain values for variables:

    my $m = new MathExpr;
    $m->parse("(x - 1) / (x + 1)");
    foreach (0 .. 10) {
        print $_, "\t", $m->val({x => $_}), "\n";
    }

=item optimize

Optimizes the AST generated by parse(), that is evaluates any subexpression 
that only depends on numerical constants, e.g.

    a + 3 * 4

becomes

    a + 12

Please note that the optimization by itself is rather costly compared to the
evaluation by C<val()>, so only do this if you plan to evaluate the expression
multiple times, and be sure to benchmark it to know if you do the right thing.

If you don't know how the expression looks like (e.g. user supplied input) you
should call optimize() if you evaluate the expression at least 20 times.

=back

=head1 LICENSE

This module is free software. You may use, redistribute and modify it under
the same terms as perl itself.

=head1 AUTHOR

Moritz Lenz, L<http://moritz.faui2k3.org/>, moritz@faui2k3.org

=head1 DEVELOPMENT

You can obtain the latest development version via subversion:

    svn co https://casella.verplant.org/svn/moritz/cpan/Math-Expression-Evaluator/

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->{tokens} = [];
    $self->{variables} = {};
    
    my $first = shift;

    if (defined $first){
        if (ref $first){
            $self->{config} = $first;
            $self->parse(shift) if @_;
        } else {
            $self->parse($first);
        }
    }

    return $self;
}


# parse a text into an AST, stores the AST in $self->{ast}
sub parse {
    my ($self, $text) = @_;
    my $ast = Math::Expression::Evaluator::Parser::parse($text, $self->{config});
    $self->{ast} = simplify_ast($ast);
    return $self;
}



sub optimize {
    my ($self) = @_;
    require Math::Expression::Evaluator::Optimizer;
    $self->{ast} = Math::Expression::Evaluator::Optimizer::_optimize($self, $self->{ast});
    return $self;
}

# evaluates an arbitrary AST, and returns its value
sub _execute {
    my ($self, $ast) = @_;
    my %dispatch = (
            '/' => sub {my $self = shift; 1 / $self->_execute(shift)},
            '-' => sub {my $self = shift; 0 - $self->_execute(shift)},
            '+' => \&_exec_sum,
            '*' => \&_exec_mul,
            '^' => sub {my $self = shift; $self->_execute(shift) **  $self->_execute(shift)},
            '=' => \&_exec_assignment,
            '&' => \&_exec_function_call,
            '{' => \&_exec_block,
            '$' => sub { my $self = shift; $self->_variable_lookup(@_) },
    );
#   print STDERR "Executing " . Dumper($self->{ast});
    if (ref $ast ){
        my @a = @$ast;
        my $op = shift @a;
        if (my $fun = $dispatch{$op}){
            return &$fun($self, @a);
        } else {
            confess ("Operator '$op' not yet implemented\n");
        }
    } else {
        return $ast;
    }
}

# executes a sum
sub _exec_sum {
    my $self = shift;
    my $sum = 0;
    foreach (@_){
        $sum += $self->_execute($_);
    }
    return $sum;
}

# executes a value
sub val {
    my $self = shift;
    $self->{temp_vars} = shift || {};
    my $res =  $self->_execute($self->{ast});
    $self->{temp_vars} = {};
    return +$res;
}

# executes a block, eg a list of statements
sub _exec_block {
    my $self = shift;
#   warn "Executing block: ". Dumper(\@_);
    my $res;
    foreach (@_){
        $res = $self->_execute($_);
    }
    return $res;
}

# executes a multiplication 
sub _exec_mul {
    my $self = shift;
    my $prod = 1;
    foreach (@_){
        $prod *= $self->_execute($_);
    }
    return $prod;
}

# executes an _assignment
sub _exec_assignment {
    my ($self, $lvalue, $rvalue) = @_;
    if ((!ref $lvalue) or $lvalue->[0] ne '$'){
        confess('Internal error: $lvalue is not a "variable" AST');
    }
    return $self->{variables}{$lvalue->[1]} = $self->_execute($rvalue);
}

# executes a function call
# currently only builtins are supported
sub _exec_function_call {
    my $self = shift;
    my $name = shift;
    my %builtin_dispatch = (
            'sqrt'  => sub { sqrt $_[0] },
            'sin'   => sub { sin  $_[0] },
            'asin'  => sub { asin $_[0] },
            'cos'   => sub { cos  $_[0] },
            'acos'  => sub { acos $_[0] },
            'tan'   => sub { tan  $_[0] },
            'atan'  => sub { atan $_[0] },
            'exp'   => sub { exp  $_[0] },
            'log'   => sub { log  $_[0] },
            'sinh'  => sub { (exp($_[0]) - exp(-$_[0]))/2},
            'cosh'  => sub { (exp($_[0]) + exp(-$_[0]))/2},
            'log10' => sub { log($_[0]) / log(10) },
            'log2'  => sub { log($_[0]) / log(2) },
            'theta' => sub { $_[0] > 0 ? 1 : 0 },
            'pi'    => sub { 3.141592653589793 },

            );
    if (my $fun = $builtin_dispatch{$name}){
        return &$fun(map {$self->_execute($_)} @_);
    } else {
        confess("Unknown function: $name");
    }
}

# checks if a variable is defined, and returns its value
sub _variable_lookup {
    my ($self, $var) = @_;
#    warn "Looking up <$var>\n";
    if (exists $self->{temp_vars} && exists $self->{temp_vars}->{$var}){
        return $self->{temp_vars}->{$var};
    } elsif (exists $self->{variables}->{$var}){
        return $self->{variables}->{$var};
    } else {
        confess("Variable '$var' not defined");
    }
}

1;

# vim: sw=4 ts=4 expandtab
