Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[cpan] MEE: many updates, nearly version 0.0.6 now

git-svn-id: svn+ssh://faui2k3.org/var/lib/svn/moritz/cpan/Math-Expression-Evaluator@660 addfbb1e-f4f9-0310-b6f0-bccd0f9b8dc6
  • Loading branch information...
commit 8c0610ef20e3684ad797fafc0ab0c936d11172a7 1 parent 886b283
moritz authored
View
3  Build.PL
@@ -9,10 +9,11 @@ my $build = Module::Build->new(
module_name => 'Math::Expression::Evaluator',
dist_author => 'Moritz Lenz',
dist_abstract => undef,
- dist_version => '0.0.4',
+ dist_version => '0.0.5',
requires => {
'Carp' => 0,
'Math::Trig' => 0,
+ 'Data::Dumper' => 0,
},
recommends => {},
sign => 0,
View
13 Changes
@@ -1,10 +1,21 @@
Revision History for Perl module Math::Expression::Evaluator
-0.0.5
+0.0.6
+- added modulo operator %
+- documented variable handling of compiled functions
+- more test cases for associativity, builtins and variables
+
+0.0.5 Mon Mar 31 13:02:29 CEST 2008
+- Added ability to compile expression to a perl function
+- Many more tests, checked with Devel::Cover
- Added "See Also" list to MEE documentation
- Lexer: track .pos in tokens
- Parser: Annotate error messages with position
- Documentation in Lexer.pm: more details on regex matching
+- non-recursive 'variables' method
+- more parse tree documentation
+- removed many trailing spaces in source code
+- simplify AST while parsing, not in a separate step
0.0.4 Wed Sep 19 17:51:01 CEST 2007
- add variables() method
View
4 MANIFEST.SKIP
@@ -29,6 +29,7 @@
\#$
\.#
\.rej$
+\.swp$
# Avoid OS-specific files/dirs
# Mac OSX metadata
@@ -37,6 +38,3 @@
\B\._
# Avoid archives of this distribution
\bMath-Expression-Evaluator-[\d\.\_]+
-
-# vim .swp backup files
-\.swp$
View
7 META.yml
@@ -1,9 +1,9 @@
---
name: Math-Expression-Evaluator
-version: 0.0.1
+version: 0.0.5
author:
- Moritz Lenz
-abstract: parses and evaluates mathematic expressions
+abstract: parses, evaluates and compiles mathematic expressions
license: perl
resources:
license: http://dev.perl.org/licenses/
@@ -11,10 +11,11 @@ requires:
Carp: 0
Math::Trig: 0
Regexp::Common: 0
+ Data::Dumper: 0
provides:
Math::Expression::Evaluator:
file: lib/Math/Expression/Evaluator.pm
- version: 0.0.1
+ version: 0.0.5
Math::Expression::Evaluator::Lexer:
file: lib/Math/Expression/Evaluator/Lexer.pm
generated_by: Module::Build version 0.2808
View
36 benchmark.pl
@@ -9,32 +9,46 @@
use Data::Dumper;
my $statement = '2 + a + 5 + (3+4)';
-
-my $test = Math::Expression::Evaluator->new($statement);
-print Dumper $test->{ast};
-$test->optimize;
-print Dumper $test->{ast};
+my $iterations = $ARGV[0] || 200;
sub with_optimize {
- my $count = shift || confess "foo";
my $m = Math::Expression::Evaluator->new($statement);
$m->optimize;
- for (1..$count){
+ for (1..$iterations){
$m->val({a => $_});
}
}
sub no_optimize {
- my $count = shift || confess "foo";
my $m = Math::Expression::Evaluator->new($statement);
- for (1..$count){
+ for (1..$iterations){
$m->val({a => $_});
}
}
+sub compiled {
+ my $m = Math::Expression::Evaluator->new($statement);
+ my $c = $m->compiled();
+ for (1..$iterations){
+ $c->({a => $_});
+ }
+}
+
+sub opt_compiled {
+ my $m = Math::Expression::Evaluator->new($statement);
+ $m->optimize();
+ my $c = $m->compiled();
+ for (1..$iterations){
+ $c->({a => $_});
+ }
+}
+
+
my %tests = (
- optimize => sub { with_optimize(10) },
- no_optimize => sub { no_optimize(10) },
+ optimize => \&with_optimize,
+ no_optimize => \&no_optimize,
+ compiled => \&compiled,
+ opt_compiled => \&opt_compiled,
);
#for (100,1000,10000){
# print $_, "\n";
View
200 lib/Math/Expression/Evaluator.pm
@@ -2,17 +2,18 @@ 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 Math::Expression::Evaluator::Util qw(is_lvalue);
+use Data::Dumper;
+use POSIX qw(ceil floor);
use Carp;
use Math::Trig qw(atan asin acos tan);
-our $VERSION = '0.0.4';
+our $VERSION = '0.0.6';
=head1 NAME
-Math::Expression::Evaluator - parses and evaluates mathematic expressions
+Math::Expression::Evaluator - parses, compiles and evaluates mathematic expressions
=head1 SYNOPSIS
@@ -28,13 +29,24 @@ Math::Expression::Evaluator - parses and evaluates mathematic expressions
print $m->parse("log2(16)")->val(), "\n";
# prints 4
+ # if you care about speed
+ my $func = $m->parse('2 + (4 * b)')->compiled;
+ for (0 .. 100){
+ print $func->({b => $_}), "\n";
+ }
+
=head1 DESCRIPTION
-Math::Expression::Evaluator is a simple, recursive descending parser for
+Math::Expression::Evaluator is a parser, compiler and interpreter for
mathematical expressions. It can handle normal arithmetics
(includings powers ^), builtin functions like sin() and variables.
+Multiplication C<*>, division C</> and modulo C<%> have the same precedence,
+and are evaluated left to right. The modulo operation follows the standard
+perl semantics, that is is the arguments are castet to integer before
+preforming the modulo operation.
+
Multiple exressions can be seperated by whitespaces or by semicolons ';'.
In case of multiple expressions the value of the last expression is
returned.
@@ -79,6 +91,10 @@ logarithms: log, log2, log10
constants: pi() (you need the parenthesis to distinguish it from the
variable pi)
+=item *
+
+rounding: ceil(), floor()
+
=item *
other: theta (theta(x) = 1 for x > 0, theta(x) = 0 for x < 0)
@@ -106,6 +122,19 @@ Returns a reference to the object, so that method calls can be chained:
Parse failures cause this method to die with a stack trace.
+=item compiled
+
+Returns an anonymous function that is a compiled version of the current
+expression. It is much faster to execute than the other methods, but its error
+messages aren't as informative (instead of complaining about a non-existing
+variable it dies with C<Use of uninitialized value in...>).
+
+Note that variables are not persistent between calls to compiled functions
+(and it wouldn't make sense anyway, because such a function corresponds always
+to exactly one expression, not many as a MEE object).
+
+Variables that were stored at the time when C<compiled()> is called are
+availble in the compiled function, though.
=item val
@@ -134,28 +163,50 @@ C<variables()> returns a list of variables that are used in the expression.
=back
-=head1 INTERNALS
+=head1 SPEED
-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).
+MEE isn't as fast as perl, because it is built on top of perl.
-=head1 SEE ALSO
+If you execute an expression multiple times, it pays off to either optimize
+it first, or (even better) compile it to a pure perl function.
+
+ Rate no_optimize optimize opt_compiled compiled
+ no_optimize 83.9/s -- -44% -82% -83%
+ optimize 150/s 78% -- -68% -69%
+ opt_compiled 472/s 463% 215% -- -4%
+ compiled 490/s 485% 227% 4% --
-=head2 Other Modules in this Distribution
+This shows the time for 200 evaluations of C<2+a+5+(3+4)> (with MEE 0.0.5).
+As you can see, the non-optimized version is painfully slow, optimization
+nearly doubles the execution speed. The compiled and the
+optimized-and-then-compiled versions are both much faster.
-L<Math::Expression::Evaluator::Lexer> breaks the input string into tokens.
+With this example expression the optimization prior to compilation pays off
+if you evaluate it more than 1000 times. But even if you call it C<10**5>
+times the optimized and compiled version is only 3% faster than the directly
+compiled one (mostly due to perl's overhead for method calls).
-L<Math::Expression::Evaluator::Parser> turns the tokens into a parse
-tree / AST.
+So to summarize you should compile your expresions, and if you have really
+many iterations it might pay off to optimize it first (or to write your
+program in C instead ;-).
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+Modulo operator produces an unnecessary big AST, making it relatively slow
+
+=back
-L<Math::Expression::Evaluator::Optimizer> contains routines that simplify
-and optinize the AST.
+=head1 INTERNALS
-L<Math::Expression::Evaluator::Util> contains common routines that are used
-in various of the other modules and shouldn't be of much interest for you.
+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).
-=head2 Other Distributions
+=head1 SEE ALSO
L<Math::Expression> also evaluates mathematical expressions, but also handles
string operations.
@@ -204,8 +255,8 @@ sub new {
# 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);
+ $self->{ast} =
+ Math::Expression::Evaluator::Parser::parse($text, $self->{config});
return $self;
}
@@ -226,6 +277,7 @@ sub _execute {
'-' => sub {my $self = shift; 0 - $self->_execute(shift)},
'+' => \&_exec_sum,
'*' => \&_exec_mul,
+ '%' => sub {my $self = shift; $self->_execute($_[0]) % $self->_execute($_[1]) },
'^' => sub {my $self = shift; $self->_execute(shift) ** $self->_execute(shift)},
'=' => \&_exec_assignment,
'&' => \&_exec_function_call,
@@ -289,7 +341,7 @@ sub _exec_mul {
# executes an _assignment
sub _exec_assignment {
my ($self, $lvalue, $rvalue) = @_;
- if ((!ref $lvalue) or $lvalue->[0] ne '$'){
+ if (!is_lvalue($lvalue)){
confess('Internal error: $lvalue is not a "variable" AST');
}
return $self->{variables}{$lvalue->[1]} = $self->_execute($rvalue);
@@ -302,6 +354,8 @@ sub _exec_function_call {
my $name = shift;
my %builtin_dispatch = (
'sqrt' => sub { sqrt $_[0] },
+ 'ceil' => sub { ceil $_[0] },
+ 'floor' => sub { floor $_[0]},
'sin' => sub { sin $_[0] },
'asin' => sub { asin $_[0] },
'cos' => sub { cos $_[0] },
@@ -317,7 +371,7 @@ sub _exec_function_call {
'theta' => sub { $_[0] > 0 ? 1 : 0 },
'pi' => sub { 3.141592653589793 },
- );
+ );
if (my $fun = $builtin_dispatch{$name}){
return &$fun(map {$self->_execute($_)} @_);
} else {
@@ -329,7 +383,7 @@ sub _exec_function_call {
sub _variable_lookup {
my ($self, $var) = @_;
# warn "Looking up <$var>\n";
- if (exists $self->{temp_vars} && exists $self->{temp_vars}->{$var}){
+ if (exists $self->{temp_vars}->{$var}){
return $self->{temp_vars}->{$var};
} elsif (exists $self->{variables}->{$var}){
return $self->{variables}->{$var};
@@ -355,19 +409,105 @@ sub variables {
my ($self) = shift;
my %vars;
my $v;
- $v = sub {
- my $ast = shift;
- return unless ref $ast;
+ my @todo = ($self->{ast});
+ while (@todo){
+ my $ast = shift @todo;
+ next unless ref $ast;
if ($ast->[0] eq '$'){
$vars{$ast->[1]}++;
} else {
- &$v($_) for @$ast;
+ # XXX do we need push the first element of @$ast?
+ push @todo, @$ast;
}
- };
- &$v($self->{ast});
+ }
return sort keys %vars;
}
+# emit perl code for an AST.
+# needed for compiling an expression into a anonymous sub
+sub _ast_to_perl {
+ my $ast = shift;
+ return $ast unless ref $ast;
+
+ my $joined_operator = sub {
+ my $op = shift;
+ return sub {
+ join $op, map { '(' . _ast_to_perl($_). ')' } @_
+ };
+ };
+
+ my %translations = (
+ '$' => sub { qq/( exists \$vars{$_[0]} ? \$vars{$_[0]} : \$default_vars{$_[0]})/ },
+ '{' => sub { join "\n", map { _ast_to_perl($_) . ";" } @_ },
+ '=' => sub { qq/\$vars{$_[0][1]} = / . _ast_to_perl($_[1]) },
+ '+' => &$joined_operator('+'),
+ '*' => &$joined_operator('*'),
+ '^' => &$joined_operator('**'),
+ '%' => &$joined_operator('%'),
+ '-' => sub { '-(' . _ast_to_perl($_[0]) . ')' },
+ '/' => sub { '1/(' . _ast_to_perl($_[0]) . ')' },
+ '&' => \&_builtin_to_perl,
+ );
+ my ($action, @rest) = @$ast;
+ my $do = $translations{$action};
+ if ($do){
+ return &$do(@rest);
+ } else {
+ confess "Internal error: don't know what to do with '$action'";
+ }
+}
+
+sub _builtin_to_perl {
+ my ($name, @args) = @_;
+ my %builtins = (
+ sqrt => sub { "sqrt($_[0])" },
+ ceil => sub { "ceil($_[0])" },
+ floor => sub { "floor($_[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 { "do { my \$t=$_[0]; (exp(\$t) - exp(-(\$t)))/2}" },
+ cosh => sub { "do { my \$t=$_[0]; (exp(\$t) + exp(-(\$t)))/2}" },
+ log10 => sub { "log($_[0]) / log(10)" },
+ log2 => sub { "log($_[0]) / log(2)" },
+ theta => sub { "$_[0] > 0 ? 1 : 0" },
+ pi => sub { "3.141592653589793" },
+ );
+ my $do = $builtins{$name};
+ if ($do){
+ return &$do(map { _ast_to_perl($_) } @args );
+ } else {
+ confess "Unknow function '$name'";
+ }
+}
+
+sub compiled {
+ my $self = shift;
+ local $Data::Dumper::Indent = 0;
+ local $Data::Dumper::Terse = 1;
+ my $text = <<'CODE';
+sub {
+ my %vars = %{; shift || {} };
+ use warnings FATAL => qw(uninitialized);
+ no warnings 'void';
+ my %default_vars = %{;
+CODE
+ chomp $text;
+ $text .= Dumper($self->{variables}) . "};\n ";
+ $text .= _ast_to_perl($self->{ast});
+ $text .= "\n}\n";
+# print STDERR "\n$text";
+ my $res = eval $text;
+ confess "Internal error while compiling: $@" if $@;
+# warn ref $res, $/;
+ return $res;
+}
+
1;
# vim: sw=4 ts=4 expandtab
View
23 lib/Math/Expression/Evaluator/Lexer.pm
@@ -1,4 +1,5 @@
-package Math::Expression::Evaluator::Lexer;
+package # hide from PAUSE indexer;
+ Math::Expression::Evaluator::Lexer;
use warnings;
use strict;
use Carp qw(confess);
@@ -80,23 +81,25 @@ sub lex {
my ($text, $tokens) = @_;
confess("passed undefined value to lex()") unless defined $text;
my $l = length $text;
- return unless ($l);
+ return [] unless ($l);
my $old_pos = 0;
my @res;
- while ($old_pos < $l){
+
+ # avoid 'Use of uninitialized value in numeric lt (<)' warnings:
+ pos($text) = 0;
+
+ while (pos($text) < $l){
my $matched = 0;
REGEXES:
for (@$tokens){
my $re = $_->[1];
- # failed regex matches reset pos(), so we need to set it
- # manually
- pos($text) = $old_pos;
- if ($text =~ m/\G($re)/){
+ # failed regex matches reset pos() unless the /c modifier
+ # is present
+ if ($text =~ m/\G($re)/gc){
$matched = 1;
my $match = $1;
- $old_pos += length $match;
if (length $match == 0){
confess("Each token has to require at least one "
. "character; Rule $_->[0] matched Zero!\n");
@@ -105,14 +108,14 @@ REGEXES:
$match = &{$_->[2]}($match);
}
if (defined $match && length $match){
- push @res, [$_->[0], $match, $old_pos - length($match)];
+ push @res, [$_->[0], $match, pos($text) - length($match)];
# push @res, [$_->[0], $match];
}
next REGEXES;
}
}
if ($matched == 0){
- confess("No token matched input text <$text> at position $old_pos");
+ confess("No token matched input text <$text> at position " . pos($text));
}
}
return \@res;
View
10 lib/Math/Expression/Evaluator/Optimizer.pm
@@ -1,4 +1,5 @@
-package Math::Expression::Evaluator::Optimizer;
+package # hide from PAUSE indexer
+ Math::Expression::Evaluator::Optimizer;
use strict;
use warnings;
@@ -60,10 +61,9 @@ usually have a net gain over unoptimized execution if C<< $n > 15 >>.
Of course that value depends on the complexity of the expression, and how
well it can be reduced by the implemented optimizations.
-Your best is to always benchmark what you do. If you are really serious about
-performance, you can use L<Math::Calculus::Expression> and its method
-C<simplify>.
-
+Your best is to always benchmark what you do. Most of the time the compiled
+version returned by C<< ->compiled >> is much faster than the optimized
+(and not compiled) form.
=cut
my %is_commutative = (
View
83 lib/Math/Expression/Evaluator/Parser.pm
@@ -1,38 +1,37 @@
-package Math::Expression::Evaluator::Parser;
+package #hide from PAUSE indexer
+ Math::Expression::Evaluator::Parser;
=head1 NAME
Math::Expression::Evaluator::Parser - Parse mathematical expressions
=head1 SYNOPSIS
-
+
use Math::Expression::Evaluator::Parser;
- use Math::Expression::Evaluator::Util qw(simplify_ast);
my $exp = '2 + a * 4';
my $ast = Math::Expression::Evaluator::Parser::parse($exp, {});
- $ast = simplify_ast($ast);
# $ast is now something like this:
# $ast = ['+',
# 2,
# ['*',
# ['$', 'a'],
# 4
- # ]
- # ];
+ # ]
+ # ];
=head1 DESCRIPTION
-This module parses a mathematical expression in usual notation, and
+This module parses a mathematical expression in usual notation, and
turns it into an Abstract Syntax Tree (AST).
-If you want to have a simple interface and want to evaluate these
+If you want to have a simple interface and want to evaluate these
ASTs, use L<Math::Expression::Evaluator>.
The AST is a tree that consists of nested array refs. The first item
is a string (until now always a single character), and denotes the type
of the node. The rest of the items in the array is a list of its arguments.
-For the mathematical symbols C<+>, C<->, C<*>, C</>, C<^> (exponentation)
+For the mathematical symbols C<+>, C<->, C<*>, C</>, C<^> (exponentation)
this is straight forward, but C</> and C<-> are always treated as prefix ops,
so the string '2 - 3' is actually turned into C<['+', 2, ['-', 3]]>.
@@ -53,6 +52,10 @@ C<['{', $expr1, $expr2, ... ]> represents a block, i.e. a list of expressions.
C<['=', $var, $expr]> represents an assignment, where C<$expr> is assigned
to C<$var>.
+=item '&'
+
+C<['&', $name, @args]> is a function toll to the function called C<$name>.
+
=back
=head1 METHODS
@@ -61,10 +64,10 @@ to C<$var>.
=item parse
-C<parse> takes a string and a hash ref, where the hash ref takes
-configuration parameters. Currently the only allowed option is
+C<parse> takes a string and a hash ref, where the hash ref takes
+configuration parameters. Currently the only allowed option is
C<force_semicolon>. If set to a true value, it forces statements to
-be forced by semicolons (so C<2 3> will be forbidden, C<2; 3> is still
+be forced by semicolons (so C<2 3> will be forbidden, C<2; 3> is still
allowed).
C<parse> throws an exception on parse errors.
@@ -77,14 +80,14 @@ use strict;
use warnings;
use Math::Expression::Evaluator::Lexer qw(lex);
-use Math::Expression::Evaluator::Util qw(is_lvalue simplify_ast);
+use Math::Expression::Evaluator::Util qw(is_lvalue);
use Carp qw(confess);
use Data::Dumper;
my @input_tokens = (
['ExpOp' => '\^'],
- ['MulOp' => '\*|/'],
+ ['MulOp' => qr{[*/%]}],
['AddOp' => '\+|-'],
# This regex is 'stolen' from Regexp::Common, and a bit simplified
# Copyright by Damian Conway and Abigail, 2001-2005
@@ -112,7 +115,7 @@ sub parse {
my ($text, $parse_opts) = @_;
- # note that is object is only used internally, to the
+ # note that this object is only used internally, to the
# world outside we hide it.
my $self = bless {};
$self->{config} = $parse_opts;
@@ -132,19 +135,15 @@ sub _is_next_token {
}
}
-# basically the same _is_next_token, but does an arbitrary number of lookahead
-# steps. An asterisk '*' stands for an arbitrary token.
+# basically the same _is_next_token, but does an arbitrary number of lookahead
+# steps.
sub _lookahead {
my $self = shift;
my $i = 0;
while (my $v = shift){
return undef unless($self->{tokens}[$self->{token_pointer}+$i]);
- if ($v eq "*") {
- $i++;
- next;
- }
my $ref = $self->{tokens}[$self->{token_pointer} + $i]->[0];
- return undef unless($ref eq $v);
+ return undef unless($ref eq $v);
$i++;
}
return 1;
@@ -163,7 +162,7 @@ sub _next_token {
}
# program -> statement*
-# parse a program, e.g. a collection of statements.
+# parse a program, e.g. a collection of statements.
# The corrsponding AST looks like this: ['{', $s1, $s2, $s3, ... ]
sub _program {
my $self = shift;
@@ -171,11 +170,11 @@ sub _program {
while (defined $self->_next_token()){
push @res, $self->_statement();
}
- return \@res;
+ return _return_simplify(@res);
}
-# generates an error message that something was expected but not found,
-# for example 'a + +' would warn that a value was expected, but an AddOp
+# generates an error message that something was expected but not found,
+# for example 'a + +' would warn that a value was expected, but an AddOp
# was found.
sub _expected {
my $self = shift;
@@ -196,10 +195,6 @@ sub _match {
my $val;
confess("Expected $m, got EOF") unless ref $self->_next_token();
if ($self->_next_token()->[0] eq $m){
- my $next = shift;
- if ($next && $next ne $self->_next_token()->[1]){
- $self->_expected($next, $self->_next_token()->[1]);
- }
$val = $self->_next_token()->[1];
$self->_proceed();
return $val;
@@ -231,10 +226,11 @@ sub _function_call {
if ($self->_is_next_token("ClosingParen")){
$self->_proceed();
return \@res;
- }
+ }
push @res, $self->_expression();
while ($self->_is_next_token("Comma")){
$self->_proceed();
+ last if $self->_is_next_token('ClosingParen');
push @res, $self->_expression();
}
$self->_match("ClosingParen");
@@ -304,11 +300,15 @@ sub _term {
} elsif ($op eq '/'){
$self->_proceed();
push @res, ['/', $self->_exponential()];
+ } elsif ($op eq '%') {
+ $self->_proceed();
+ # XXX not very efficient
+ @res = ('*', ['%', [@res], $self->_exponential()]);
} else {
die "Don't know how to handle MulOp $op\n";
}
}
- return \@res;
+ return _return_simplify(@res);
}
# <expression> ::= ['+'|'-']? <term> [('+'|'-') term]*
@@ -317,7 +317,7 @@ sub _expression {
# print STDERR "expression...\n";
my @res = ('+');
if (my $op = $self->_is_next_token("AddOp")){
-# unary +/-
+ # unary +/-
$self->_proceed();
if ($op eq '+'){
push @res, $self->_term();
@@ -331,14 +331,13 @@ sub _expression {
if ($op eq '+'){
$self->_proceed();
push @res, $self->_term();
- } elsif ($op eq '-'){
+ } else {
+ # a '-'
$self->_proceed();
push @res, ['-', $self->_term()];
- } else {
- confess("weird things...\n");
}
}
- return \@res;
+ return _return_simplify(@res);
}
# <factor> ::= <value> | '(' <expression> ')'
@@ -346,9 +345,9 @@ sub _factor {
my $self = shift;
my $val;
if ($self->_is_next_token("OpenParen")){
- $self->_match("OpenParen", '(');
+ $self->_match("OpenParen");
$val = $self->_expression();
- $self->_match("ClosingParen", ')');
+ $self->_match("ClosingParen");
} else {
$val = $self->_value();
}
@@ -365,10 +364,14 @@ sub _exponential {
return ['^', $val, $self->_factor()];
} else {
return $val;
-
}
}
+sub _return_simplify {
+ return $_[1] if @_ == 2;
+ return \@_;
+}
+
1;
# vim: sw=4 ts=4 expandtab
View
36 lib/Math/Expression/Evaluator/Util.pm
@@ -1,4 +1,5 @@
-package Math::Expression::Evaluator::Util;
+package # hide from PAUSE indexer
+ Math::Expression::Evaluator::Util;
=head1 NAME
@@ -7,8 +8,7 @@ Math::Expression::Evaluator
=head1 SYNPOSIS
- use Math::Expression::Evaluator::Util qw(simplify_ast is_lvalue);
- $ast = simplify_ast($ast);
+ use Math::Expression::Evaluator::Util qw(is_lvalue);
# ...
if (is_lvalue($ast)){
@@ -22,16 +22,6 @@ the Math::Expression::Evaluator distribution.
=over
-=item simplify_ast
-
-C<simplify_ast> takes a reference to an AST, and returns a simplified
-version. It just prunes no-op AST nodes and flattens the AST.
-
-For example it turns C<['*', [@foo]]> into C<[@foo]> for arbitrary values
-of C<@foo>.
-
-For a description of the AST see L<Math::Expression::Evaluator::Parser>.
-
=item is_lvalue
C<is_lvalue($ast)> checks if (a simplified version of) C<$ast> represents
@@ -46,27 +36,11 @@ use warnings;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(simplify_ast is_lvalue);
-
-sub simplify_ast {
- my $ast = shift;
- return $ast unless ref $ast;
- my @a = @$ast;
- my %simplifiable = map { $_ => 1 } ('+', '*', '{');
- if (scalar @a == 2 && $simplifiable{$a[0]}){
- # turns ['+', $foo] into $foo
- return simplify_ast($a[1]);
- }
- my @res;
- for (@a){
- push @res, simplify_ast($_);
- }
- return \@res;
-}
+our @EXPORT_OK = qw(is_lvalue);
# checks if the given AST represents a lvalue of an _assignment
sub is_lvalue {
- my $ast = simplify_ast(shift);
+ my $ast = shift;
if (ref($ast) && $ast->[0] eq '$'){
# simple variable name
return 1;
View
18 t/03-basic-usage.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+BEGIN { plan tests => 3 }
+
+use Math::Expression::Evaluator;
+
+my $m = new Math::Expression::Evaluator;
+ok($m, "new works");
+
+$m = Math::Expression::Evaluator->new('2+3');
+
+is $m->val(), 5, '->new($expression)';
+
+$m = Math::Expression::Evaluator->new({}, '2+3');
+
+is $m->val(), 5, '->new(\%options, $expression)';
View
67 t/builtins.t
@@ -1,29 +1,70 @@
use strict;
use warnings;
use Test::More;
-BEGIN { plan tests => 9 }
+BEGIN { plan tests => 64 }
use Math::Expression::Evaluator;
my $m = new Math::Expression::Evaluator;
-ok($m, "new works");
+# asin() seems to have a bad precision, so setting $epsilon
+# to 1e-7 will cause a failure here. D'oh.
my $epsilon = 1e-6;
sub e {
- return $m->parse(shift)->val();
+ return $m->parse(shift)->val();
}
sub is_approx {
- my ($expr, $expected, $message) = @_;
- ok abs($m->parse($expr)->val() - $expected) <= $epsilon, $message;
+ my ($expr, $expected, $message) = @_;
+ ok abs($m->parse($expr)->val() - $expected) <= $epsilon,
+ $message;
+ ok abs(&{$m->parse($expr)->compiled}() - $expected) <= $epsilon,
+ "$message (compiled)";
}
-is e('sqrt(4)'), 2, 'sqrt';
-is_approx 'pi()', 3.141592, 'pi';
-is_approx 'sin(pi())', 0, 'sin(pi())';
-is_approx 'sin(pi()/2)', 1, 'sin(pi()/2)';
-is_approx 'sin(0)', 0, 'sin(0)';
-is_approx 'cos(0)', 1, 'cos(0)';
-is_approx 'exp(0)', 1, 'exp(0)';
-is_approx 'log2(8)', 3, 'log2(8)';
+is_approx 'sqrt(4)', 2, 'sqrt';
+is_approx 'sqrt(4,)', 2, 'sqrt'; # trailing comma allowed
+is_approx 'pi()', 3.14159265, 'pi';
+is_approx 'sin(pi())', 0, 'sin(pi())';
+is_approx 'sin(pi()/2)', 1, 'sin(pi()/2)';
+is_approx 'sin(0)', 0, 'sin(0)';
+is_approx 'sin(sin(0.1))', 0.09966766, 'nested sin';
+is_approx 'cos(0)', 1, 'cos(0)';
+is_approx 'exp(0)', 1, 'exp(0)';
+is_approx 'exp(3)', 20.085537, 'exp(3)';
+is_approx 'log(exp(2))', 2, 'log(exp(2))';
+is_approx 'log10(100)', 2, 'log10(100)';
+is_approx 'log2(8)', 3, 'log2(8)';
+is_approx 'sinh(0)', 0, 'sinh(0)';
+is_approx 'sinh(1)', 1.1752012, 'sinh(1)';
+is_approx 'sinh(sinh(1.1))',1.76973464, 'nested sinh';
+is_approx 'cosh(0)', 1, 'cosh(0)';
+is_approx 'cosh(1)', 1.5430806, 'cosh(1)';
+is_approx 'theta(-3)', 0, 'theta(-3)';
+is_approx 'theta(0)', 0, 'theta(0)';
+is_approx 'theta(0.1)', 1, 'theta(0.1)';
+is_approx 'asin(0.5)', 0.523599, 'asin(0.5)';
+is_approx 'acos(0.5)', 1.0471976, 'acos(0.5)';
+is_approx 'tan(0.5)', 0.54630249, 'tan(0.5)';
+is_approx 'atan(0.5)', 0.46364761, 'atan(0.5)';
+is_approx 'ceil(3)', 3, 'ceil(3)';
+is_approx 'ceil(2.3)', 3, 'ceil(2.3)';
+is_approx 'ceil(-2.3)', -2, 'ceil(-2)';
+is_approx 'floor(3)', 3, 'floor(3)';
+is_approx 'floor(2.3)', 2, 'floor(2.3)';
+is_approx 'floor(-2.3)', -3, 'floor(-2.3)';
+
+# parse test for a function with at least two arguments
+# so far there is no such builtin, but it might be some time..
+eval {
+ $m->parse('foo(a, b, c)');
+};
+ok !$@, 'function call with multiple arguments parses';
+
+eval {
+ $m->val({ a => 1, b => 2, c => 3 });
+};
+
+ok $@, 'dies while calling undefined function';
+
View
7 t/multiple-expressions.t
@@ -1,12 +1,11 @@
use strict;
use warnings;
use Test::More;
-BEGIN { plan tests => 7 }
+BEGIN { plan tests => 9 }
use Math::Expression::Evaluator;
my $m = new Math::Expression::Evaluator;
-ok($m, "new works");
sub o {
return $m->parse(shift)->optimize->val();
@@ -14,6 +13,9 @@ sub o {
sub e {
return $m->parse(shift)->val();
}
+sub c {
+ return &{$m->parse(shift)->compiled}();
+}
my @tests = (
['1 2', 2, 'space delimited expressions'],
@@ -24,6 +26,7 @@ my @tests = (
for (@tests){
is e($_->[0]), $_->[1], $_->[2];
is o($_->[0]), $_->[1], $_->[2] . ' (optimized)';
+ is c($_->[0]), $_->[1], $_->[2] . ' (compiled)';
}
# vim: expandtab
View
1  t/optimize.t
@@ -17,6 +17,7 @@ BEGIN {
'a ^ (-2)',
'a * 2 * (3 * 4)',
'a + 2 + (3 + 4)',
+ 'b = a; b * 2',
);
plan tests => scalar @tests;
}
View
12 t/parsefails.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use Test::More;
-BEGIN { plan tests => 14 }
+BEGIN { plan tests => 17 }
use Math::Expression::Evaluator;
@@ -14,6 +14,12 @@ sub parse_fail {
ok($@, $explanation);
}
+sub parse_ok {
+ my ($string, $explanation) = @_;
+ eval { $m->parse($string) };
+ ok(!$@, $explanation);
+}
+
parse_fail '1^', 'Dangling infix operator ^';
parse_fail '1*', 'Dangling infix operator *';
parse_fail '1/', 'Dangling infix operator /';
@@ -27,10 +33,14 @@ parse_fail '1 ** 2', 'two operators in a row 2';
parse_fail '3 = 4', 'assignment to non-lvalue 1';
parse_fail 'a + b = 4', 'assignment to non-lvalue 2';
+parse_fail '&', 'lex failure: disallowed token';
+
# force a semicolon between statements:
$m = Math::Expression::Evaluator->new({force_semicolon => 1});
parse_fail '2 3', 'space seperated expressions (with force_semicolon)';
parse_fail 'a*b 3', 'two terms in a row (with force_semicolon)';
+parse_ok '2;', 'single statement with trailing semicolon';
+parse_ok '2', 'single statement without trailing semicolon';
# vim: sw=4 ts=4 expandtab
View
19 t/precedence.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use Test::More;
-BEGIN { plan tests => 29 }
+BEGIN { plan tests => 73 }
use Math::Expression::Evaluator;
@@ -15,8 +15,13 @@ sub o {
return $m->parse(shift)->optimize->val();
}
+sub c {
+ return &{$m->parse(shift)->compiled}();
+}
+
my @tests = (
['1+2*3', 7, '* over +'],
+ ['1+3%2', 2, '% over +'],
['1-2*3', -5, '* over -'],
['1+4/2', 3, '/ over +'],
['1-4/2', -1, '/ over -'],
@@ -24,6 +29,15 @@ my @tests = (
['3-2^4', -13, '^ over -'],
['3+2^4', 19, '^ over +'],
['16/2^3', 2, '^ over /'],
+ ['16%3^2', 7, '^ over %'],
+ ['2*3%5', 1, '* and % evaluate left to right 1'],
+ ['3%5*2', 6, '* and % evaluate left to right 2'],
+ ['12/2%5', 1, '/ and % evaluate left to right 1'],
+ ['4%5/2', 2, '/ and % evaluate left to right 2'],
+ ['2*3%4/2', 1, '*, / and % eval left to right 1'],
+ ['6%4/2*3', 3, '*, / and % eval left to right 2'],
+ ['6/2%2', 1, '*, / and % eval left to right 3'],
+ ['16%9%5', 2, '% is left assoc'],
['(1)', 1, 'Parenthesis 0'],
['(1+2)*3', 9, 'Parenthesis 1'],
['(1-2)*3', -3, 'Parenthesis 2'],
@@ -34,7 +48,8 @@ my @tests = (
for (@tests){
is e($_->[0]), $_->[1], $_->[2];
- is o($_->[0]), $_->[1], $_->[2] . ' (optimized)';
+ is o($_->[0]), $_->[1], $_->[2] . ' [optimized]';
+ is c($_->[0]), $_->[1], $_->[2] . ' [compiled]';
}
# vim: sw=4 ts=4 expandtab
View
27 t/variables.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use Test::More;
-BEGIN { plan tests => 6 }
+BEGIN { plan tests => 10 }
use Math::Expression::Evaluator;
@@ -12,14 +12,37 @@ sub e {
return $m->parse(shift)->val();
}
+sub c {
+ return &{$m->parse(shift)->compiled}();
+}
+
is e('a = 3'), 3, 'Assignment returns value';
-is e('a'), 3, 'Variables persisent';
+is e('a'), 3, 'Variables persistent';
is e('a*a'), 9, 'Arithmetics with variables';
+#reset old variable values
+$m = Math::Expression::Evaluator->new();
+is c('a = 3; a*a'), 9, 'Assignment returns value (compiled)';
+
$m->parse("a + b");
is $m->val({a => 1, b => 2}), 3, 'externally assigned variables';
$m->parse("a = 3; a");
is $m->val({a => 1}), 1, 'externally provided variables override internal ones';
+# test that assignments in an expression don't modify the hash passed to
+# the 'val' or the compiled function;
+
+my $vars = { a => 1 };
+$m->parse('a = 2');
+$m->val($vars);
+is $vars->{a}, '1', 'no side effects on externally provided variables';
+
+&{$m->compiled}($vars);
+is $vars->{a}, '1', 'no side effects on externally provided variables [compiled]';
+
+$m->parse(' b = 5')->val;
+is &{$m->parse('b')->compiled}, 5, 'compiled expressions can use prev. defined variables';
+
+
# vim: sw=4 ts=4 expandtab syn=perl
Please sign in to comment.
Something went wrong with that request. Please try again.