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 Math::Trig qw(atan asin acos tan);

our $VERSION = '0.0.4';

=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 Abstract Syntax Tree(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 internal AST, so that subsequent calls to C<val()> will be 
a bit faster. See C<Math::Expression::Evaluator::Optimizer> for performance
considerations and informations on the implemented optimizations.

But note that a call to C<optimize()> only pays off if you call C<val()> 
multiple times.

=item variables

C<variables()> returns a list of variables that are used in the expression.

=back

=head1 INTERNALS

The AST can be accessed as C<$obj->{ast}>. Its structure is described in 
L<Math::Expression::Evaluator::Parser> (or you can use L<Data::Dumper> 
to figure it out for yourself).

=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");
    }
}

# used for testing purposes only:
# returns the (recursive) number of operands in the AST
sub _ast_size {
    my ($self, $ast) = @_;
    $ast = defined $ast ? $ast : $self->{ast};
    return 1 unless ref $ast;
    my $size = -1; # the initial op/type should be ignored
    for (@$ast){
        $size += $self->_ast_size($_);
    }
    return $size;
}

sub variables {
    my ($self) = shift;
    my %vars;
    my $v;
    $v = sub {
        my $ast = shift;
        return unless ref $ast;
        if ($ast->[0] eq '$'){
            $vars{$ast->[1]}++;
        } else {
            &$v($_) for @$ast;
        }
    };
    &$v($self->{ast});
    return sort keys %vars;
}

1;

# vim: sw=4 ts=4 expandtab
