| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Math::Calc::Parser; |
|
2
|
8
|
|
|
8
|
|
175631
|
use strict; |
|
|
8
|
|
|
|
|
52
|
|
|
|
8
|
|
|
|
|
241
|
|
|
3
|
8
|
|
|
8
|
|
49
|
use warnings; |
|
|
8
|
|
|
|
|
15
|
|
|
|
8
|
|
|
|
|
195
|
|
|
4
|
8
|
|
|
8
|
|
2202
|
use utf8; |
|
|
8
|
|
|
|
|
62
|
|
|
|
8
|
|
|
|
|
1806
|
|
|
5
|
8
|
|
|
8
|
|
206
|
use Carp (); |
|
|
8
|
|
|
|
|
14
|
|
|
|
8
|
|
|
|
|
103
|
|
|
6
|
8
|
|
|
8
|
|
30
|
use Exporter (); |
|
|
8
|
|
|
|
|
12
|
|
|
|
8
|
|
|
|
|
146
|
|
|
7
|
8
|
|
|
8
|
|
38
|
use List::Util (); |
|
|
8
|
|
|
|
|
16
|
|
|
|
8
|
|
|
|
|
111
|
|
|
8
|
8
|
|
|
8
|
|
4664
|
use Math::Complex (); |
|
|
8
|
|
|
|
|
95100
|
|
|
|
8
|
|
|
|
|
225
|
|
|
9
|
8
|
|
|
8
|
|
4331
|
use POSIX (); |
|
|
8
|
|
|
|
|
56954
|
|
|
|
8
|
|
|
|
|
234
|
|
|
10
|
8
|
|
|
8
|
|
57
|
use Scalar::Util (); |
|
|
8
|
|
|
|
|
15
|
|
|
|
8
|
|
|
|
|
588
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.003'; |
|
13
|
|
|
|
|
|
|
our @ISA = 'Exporter'; |
|
14
|
|
|
|
|
|
|
our @EXPORT_OK = 'calc'; |
|
15
|
|
|
|
|
|
|
our $ERROR; |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# See disclaimer in Math::Round |
|
18
|
8
|
|
|
8
|
|
48
|
use constant ROUND_HALF => 0.50000000000008; |
|
|
8
|
|
|
|
|
16
|
|
|
|
8
|
|
|
|
|
1052
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
BEGIN { |
|
21
|
8
|
|
|
8
|
|
28
|
local $@; |
|
22
|
8
|
50
|
|
|
|
14
|
if (eval { require Math::Random::Secure; 1 }) { |
|
|
8
|
|
|
|
|
3843
|
|
|
|
8
|
|
|
|
|
1295635
|
|
|
23
|
8
|
|
|
|
|
36434
|
Math::Random::Secure->import('rand'); |
|
24
|
|
|
|
|
|
|
} |
|
25
|
|
|
|
|
|
|
} |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
{ |
|
28
|
|
|
|
|
|
|
my %operators = ( |
|
29
|
|
|
|
|
|
|
'<<' => { assoc => 'left' }, |
|
30
|
|
|
|
|
|
|
'>>' => { assoc => 'left' }, |
|
31
|
|
|
|
|
|
|
'+' => { assoc => 'left' }, |
|
32
|
|
|
|
|
|
|
'-' => { assoc => 'left' }, |
|
33
|
|
|
|
|
|
|
'*' => { assoc => 'left' }, |
|
34
|
|
|
|
|
|
|
'/' => { assoc => 'left' }, |
|
35
|
|
|
|
|
|
|
'%' => { assoc => 'left' }, |
|
36
|
|
|
|
|
|
|
'^' => { assoc => 'right' }, |
|
37
|
|
|
|
|
|
|
'!' => { assoc => 'left' }, |
|
38
|
|
|
|
|
|
|
# Dummy operators for unary minus/plus |
|
39
|
|
|
|
|
|
|
'u-' => { assoc => 'right' }, |
|
40
|
|
|
|
|
|
|
'u+' => { assoc => 'right' }, |
|
41
|
|
|
|
|
|
|
); |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Ordered lowest precedence to highest |
|
44
|
|
|
|
|
|
|
my @op_precedence = ( |
|
45
|
|
|
|
|
|
|
['<<','>>'], |
|
46
|
|
|
|
|
|
|
['+','-'], |
|
47
|
|
|
|
|
|
|
['*','/','%'], |
|
48
|
|
|
|
|
|
|
['u-','u+'], |
|
49
|
|
|
|
|
|
|
['^'], |
|
50
|
|
|
|
|
|
|
['!'], |
|
51
|
|
|
|
|
|
|
); |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Cache operator precedence |
|
54
|
|
|
|
|
|
|
my (%lower_prec, %higher_prec); |
|
55
|
|
|
|
|
|
|
$higher_prec{$_} = 1 for keys %operators; |
|
56
|
|
|
|
|
|
|
foreach my $set (@op_precedence) { |
|
57
|
|
|
|
|
|
|
delete @higher_prec{@$set}; |
|
58
|
|
|
|
|
|
|
foreach my $op (@$set) { |
|
59
|
|
|
|
|
|
|
$operators{$op}{equal_to}{$_} = 1 for @$set; |
|
60
|
|
|
|
|
|
|
$operators{$op}{lower_than}{$_} = 1 for keys %higher_prec; |
|
61
|
|
|
|
|
|
|
$operators{$op}{higher_than}{$_} = 1 for keys %lower_prec; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
$lower_prec{$_} = 1 for @$set; |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
|
|
66
|
1542
|
|
|
1542
|
|
5178
|
sub _operator { $operators{shift()} } |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
{ |
|
70
|
153
|
50
|
66
|
153
|
|
666
|
sub _real { Scalar::Util::blessed $_[0] && $_[0]->isa('Math::Complex') ? $_[0]->Re : $_[0] } |
|
71
|
14
|
100
|
100
|
14
|
|
88
|
sub _each { Scalar::Util::blessed $_[0] && $_[0]->isa('Math::Complex') ? Math::Complex::cplx($_[1]->($_[0]->Re), $_[1]->($_[0]->Im)) : $_[1]->($_[0]) } |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Adapted from Math::Round |
|
74
|
4
|
100
|
|
4
|
|
35
|
sub _round { $_[0] >= 0 ? POSIX::floor($_[0] + ROUND_HALF) : POSIX::ceil($_[0] - ROUND_HALF) } |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _fact_check { |
|
77
|
25
|
|
|
25
|
|
58
|
my $r = _real($_[0]); |
|
78
|
25
|
100
|
|
|
|
101
|
die 'Factorial of negative number' if $r < 0; |
|
79
|
24
|
100
|
|
|
|
536
|
die 'Factorial of infinity' if $r == 'inf'; |
|
80
|
23
|
100
|
|
|
|
366
|
die 'Factorial of NaN' if $r != $r; |
|
81
|
22
|
|
|
|
|
210
|
return $r; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
2
|
|
|
2
|
|
46
|
sub _atan_factor { Math::BigFloat->new(1)->bsub($_[0]->copy->bpow(2))->bsqrt } |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my %functions = ( |
|
87
|
|
|
|
|
|
|
'<<' => { args => 2, code => sub { _real($_[0]) << _real($_[1]) } }, |
|
88
|
|
|
|
|
|
|
'>>' => { args => 2, code => sub { _real($_[0]) >> _real($_[1]) } }, |
|
89
|
|
|
|
|
|
|
'+' => { args => 2, code => sub { $_[0] + $_[1] } }, |
|
90
|
|
|
|
|
|
|
'-' => { args => 2, code => sub { $_[0] - $_[1] } }, |
|
91
|
|
|
|
|
|
|
'*' => { args => 2, code => sub { $_[0] * $_[1] } }, |
|
92
|
|
|
|
|
|
|
'/' => { args => 2, code => sub { $_[0] / $_[1] } }, |
|
93
|
|
|
|
|
|
|
'%' => { args => 2, code => sub { _real($_[0]) % _real($_[1]) } }, |
|
94
|
|
|
|
|
|
|
'^' => { args => 2, code => sub { $_[0] ** $_[1] } }, |
|
95
|
|
|
|
|
|
|
'!' => { args => 1, code => sub { my $r = _fact_check($_[0]); List::Util::reduce { $a * $b } 1, 1..$r }, |
|
96
|
|
|
|
|
|
|
bignum_code => sub { my $r = _fact_check($_[0]); $r->copy->bfac } }, |
|
97
|
|
|
|
|
|
|
'u-' => { args => 1, code => sub { -$_[0] } }, |
|
98
|
|
|
|
|
|
|
'u+' => { args => 1, code => sub { +$_[0] } }, |
|
99
|
|
|
|
|
|
|
sqrt => { args => 1, code => sub { Math::Complex::sqrt $_[0] }, bignum_code => sub { $_[0]->copy->bsqrt } }, |
|
100
|
|
|
|
|
|
|
pi => { args => 0, code => sub { Math::Complex::pi }, bignum_code => sub { Math::BigFloat->bpi } }, |
|
101
|
|
|
|
|
|
|
'π' => { args => 0, code => sub { Math::Complex::pi }, bignum_code => sub { Math::BigFloat->bpi } }, |
|
102
|
|
|
|
|
|
|
i => { args => 0, code => sub { Math::Complex::i }, bignum_code => sub { Math::BigFloat->bnan } }, |
|
103
|
|
|
|
|
|
|
e => { args => 0, code => sub { exp 1 }, bignum_code => sub { Math::BigFloat->new(1)->bexp } }, |
|
104
|
|
|
|
|
|
|
ln => { args => 1, code => sub { Math::Complex::ln $_[0] }, bignum_code => sub { $_[0]->copy->blog } }, |
|
105
|
|
|
|
|
|
|
log => { args => 1, code => sub { Math::Complex::log10 $_[0] }, bignum_code => sub { $_[0]->copy->blog(10) } }, |
|
106
|
|
|
|
|
|
|
logn => { args => 2, code => sub { Math::Complex::log($_[0]) / Math::Complex::log($_[1]) }, bignum_code => sub { $_[0]->copy->blog($_[1]) } }, |
|
107
|
|
|
|
|
|
|
sin => { args => 1, code => sub { Math::Complex::sin $_[0] }, bignum_code => sub { $_[0]->copy->bsin } }, |
|
108
|
|
|
|
|
|
|
cos => { args => 1, code => sub { Math::Complex::cos $_[0] }, bignum_code => sub { $_[0]->copy->bcos } }, |
|
109
|
|
|
|
|
|
|
tan => { args => 1, code => sub { Math::Complex::tan $_[0] }, bignum_code => sub { scalar $_[0]->copy->bsin->bdiv($_[0]->copy->bcos) } }, |
|
110
|
|
|
|
|
|
|
asin => { args => 1, code => sub { Math::Complex::asin $_[0] }, bignum_code => sub { $_[0]->copy->batan2(_atan_factor($_[0])->badd(1))->bmul(2) } }, |
|
111
|
|
|
|
|
|
|
acos => { args => 1, code => sub { Math::Complex::acos $_[0] }, bignum_code => sub { _atan_factor($_[0])->batan2($_[0]->copy->badd(1))->bmul(2) } }, |
|
112
|
|
|
|
|
|
|
atan => { args => 1, code => sub { Math::Complex::atan $_[0] }, bignum_code => sub { $_[0]->copy->batan } }, |
|
113
|
|
|
|
|
|
|
atan2 => { args => 2, code => sub { Math::Complex::atan2 $_[0], $_[1] }, bignum_code => sub { $_[0]->copy->batan2($_[1]) } }, |
|
114
|
|
|
|
|
|
|
abs => { args => 1, code => sub { abs $_[0] } }, |
|
115
|
|
|
|
|
|
|
rand => { args => 0, code => sub { rand }, bignum_code => sub { Math::BigFloat->new(rand) } }, |
|
116
|
|
|
|
|
|
|
int => { args => 1, code => sub { _each($_[0], sub { int $_[0] }) } }, |
|
117
|
|
|
|
|
|
|
floor => { args => 1, code => sub { _each($_[0], sub { POSIX::floor $_[0] }) }, bignum_code => sub { $_[0]->copy->bfloor } }, |
|
118
|
|
|
|
|
|
|
ceil => { args => 1, code => sub { _each($_[0], sub { POSIX::ceil $_[0] }) }, bignum_code => sub { $_[0]->copy->bceil } }, |
|
119
|
|
|
|
|
|
|
round => { args => 1, code => sub { _each($_[0], sub { _round $_[0] }) }, bignum_code => sub { $_[0]->copy->bfround(0, 'common') }, |
|
120
|
|
|
|
|
|
|
# Math::BigRat ->as_float broken with upgrading active |
|
121
|
|
|
|
|
|
|
bigrat_code => sub { local $Math::BigFloat::upgrade = undef; $_[0]->as_float->bfround(0, 'common') } }, |
|
122
|
|
|
|
|
|
|
); |
|
123
|
|
|
|
|
|
|
|
|
124
|
17
|
|
|
17
|
|
450
|
sub _default_functions { +{%functions} } |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
{ |
|
128
|
|
|
|
|
|
|
my $singleton; |
|
129
|
565
|
100
|
66
|
565
|
|
2206
|
sub _instance { Scalar::Util::blessed $_[0] ? $_[0] : ($singleton ||= $_[0]->new) } |
|
130
|
|
|
|
|
|
|
} |
|
131
|
|
|
|
|
|
|
|
|
132
|
122
|
|
|
122
|
1
|
6948
|
sub calc ($) { _instance(__PACKAGE__)->evaluate($_[0]) } |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub new { |
|
135
|
18
|
|
|
18
|
1
|
2055
|
my $class = shift; |
|
136
|
18
|
50
|
|
|
|
74
|
my %params = @_ == 1 ? %{$_[0]} : @_; |
|
|
0
|
|
|
|
|
0
|
|
|
137
|
18
|
|
|
|
|
45
|
my $self = bless {}, $class; |
|
138
|
18
|
100
|
|
|
|
56
|
$self->bignum($params{bignum}) if exists $params{bignum}; |
|
139
|
18
|
100
|
|
|
|
54
|
$self->bigrat($params{bigrat}) if exists $params{bigrat}; |
|
140
|
18
|
|
|
|
|
109
|
return $self; |
|
141
|
|
|
|
|
|
|
} |
|
142
|
|
|
|
|
|
|
|
|
143
|
2
|
|
|
2
|
1
|
1102
|
sub error { _instance(shift)->{error} } |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub bignum { |
|
146
|
429
|
|
|
429
|
1
|
683
|
my $self = shift; |
|
147
|
429
|
100
|
|
|
|
1180
|
return $self->{bignum} unless @_; |
|
148
|
1
|
|
|
|
|
7
|
$self->{bignum} = !!shift; |
|
149
|
1
|
50
|
|
|
|
3
|
if ($self->{bignum}) { |
|
150
|
1
|
|
|
|
|
5
|
require Math::BigInt; |
|
151
|
1
|
|
|
|
|
53
|
Math::BigInt->VERSION('1.87'); |
|
152
|
1
|
|
|
|
|
6
|
require Math::BigFloat; |
|
153
|
1
|
|
|
|
|
35
|
Math::BigFloat->VERSION('1.58'); |
|
154
|
1
|
|
|
|
|
7
|
Math::BigInt->upgrade('Math::BigFloat'); |
|
155
|
1
|
|
|
|
|
17
|
Math::BigFloat->downgrade('Math::BigInt'); |
|
156
|
1
|
|
|
|
|
36
|
Math::BigFloat->upgrade(undef); |
|
157
|
|
|
|
|
|
|
} |
|
158
|
1
|
|
|
|
|
7
|
return $self; |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub bigrat { |
|
162
|
429
|
|
|
429
|
1
|
583
|
my $self = shift; |
|
163
|
429
|
100
|
|
|
|
937
|
return $self->{bigrat} unless @_; |
|
164
|
1
|
|
|
|
|
7
|
$self->{bigrat} = !!shift; |
|
165
|
1
|
50
|
|
|
|
2
|
if ($self->{bigrat}) { |
|
166
|
1
|
|
|
|
|
5
|
require Math::BigInt; |
|
167
|
1
|
|
|
|
|
15
|
Math::BigInt->VERSION('1.87'); |
|
168
|
1
|
|
|
|
|
4
|
require Math::BigRat; |
|
169
|
1
|
|
|
|
|
12
|
Math::BigRat->VERSION('0.20'); |
|
170
|
1
|
|
|
|
|
4
|
require Math::BigFloat; |
|
171
|
1
|
|
|
|
|
7
|
Math::BigFloat->VERSION('1.58'); |
|
172
|
1
|
|
|
|
|
5
|
Math::BigInt->upgrade('Math::BigFloat'); |
|
173
|
1
|
|
|
|
|
14
|
Math::BigFloat->upgrade('Math::BigRat'); |
|
174
|
1
|
|
|
|
|
11
|
Math::BigFloat->downgrade(undef); |
|
175
|
|
|
|
|
|
|
} |
|
176
|
1
|
|
|
|
|
9
|
return $self; |
|
177
|
|
|
|
|
|
|
} |
|
178
|
|
|
|
|
|
|
|
|
179
|
1281
|
|
66
|
1281
|
|
3792
|
sub _functions { shift->{_functions} ||= _default_functions() } |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub add_functions { |
|
182
|
10
|
|
|
10
|
1
|
6152
|
my ($self, %functions) = @_; |
|
183
|
10
|
|
|
|
|
46
|
foreach my $name (keys %functions) { |
|
184
|
10
|
100
|
|
|
|
230
|
Carp::croak qq{Function "$name" has invalid name} unless $name =~ m/\A[a-z]\w*\z/i; |
|
185
|
9
|
|
|
|
|
16
|
my $definition = $functions{$name}; |
|
186
|
9
|
100
|
|
|
|
47
|
$definition = { args => 0, code => $definition } if ref $definition eq 'CODE'; |
|
187
|
|
|
|
|
|
|
Carp::croak qq{No argument count for function "$name"} |
|
188
|
9
|
100
|
|
|
|
117
|
unless defined (my $args = $definition->{args}); |
|
189
|
8
|
100
|
66
|
|
|
158
|
Carp::croak qq{Invalid argument count for function "$name"} |
|
190
|
|
|
|
|
|
|
unless $args =~ m/\A\d+\z/ and $args >= 0; |
|
191
|
|
|
|
|
|
|
Carp::croak qq{No coderef for function "$name"} |
|
192
|
7
|
100
|
|
|
|
124
|
unless defined (my $code = $definition->{code}); |
|
193
|
6
|
100
|
|
|
|
101
|
Carp::croak qq{Invalid coderef for function "$name"} unless ref $code eq 'CODE'; |
|
194
|
5
|
|
|
|
|
17
|
my %function = (args => $args, code => $code); |
|
195
|
5
|
50
|
|
|
|
15
|
$function{bignum_code} = $definition->{bignum_code} if defined $definition->{bignum_code}; |
|
196
|
5
|
50
|
|
|
|
10
|
$function{bigrat_code} = $definition->{bigrat_code} if defined $definition->{bigrat_code}; |
|
197
|
5
|
|
|
|
|
16
|
$self->_functions->{$name} = \%function; |
|
198
|
|
|
|
|
|
|
} |
|
199
|
5
|
|
|
|
|
15
|
return $self; |
|
200
|
|
|
|
|
|
|
} |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub remove_functions { |
|
203
|
3
|
|
|
3
|
1
|
10
|
my ($self, @functions) = @_; |
|
204
|
3
|
|
|
|
|
7
|
foreach my $name (@functions) { |
|
205
|
3
|
50
|
|
|
|
9
|
next unless defined $name; |
|
206
|
3
|
100
|
|
|
|
7
|
next if defined _operator($name); # Do not remove operator functions |
|
207
|
2
|
|
|
|
|
6
|
delete $self->_functions->{$name}; |
|
208
|
|
|
|
|
|
|
} |
|
209
|
3
|
|
|
|
|
7
|
return $self; |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my $token_re = qr{( |
|
213
|
|
|
|
|
|
|
( 0x[0-9a-f]+ | 0b[01]+ | 0[0-7]+ ) # Octal/hex/binary numbers |
|
214
|
|
|
|
|
|
|
| (?: [0-9]*\. )? [0-9]+ (?: e[-+]?[0-9]+ )? # Decimal numbers |
|
215
|
|
|
|
|
|
|
| [(),] # Parentheses and commas |
|
216
|
|
|
|
|
|
|
| \w+ # Functions |
|
217
|
|
|
|
|
|
|
| (?: [-+*/^%!] | << | >> ) # Operators |
|
218
|
|
|
|
|
|
|
| [^\s\w(),.\-+*/^%!<>]+ # Unknown tokens (but skip whitespace) |
|
219
|
|
|
|
|
|
|
)}ix; |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub parse { |
|
222
|
226
|
|
|
226
|
1
|
16851
|
my ($self, $expr) = @_; |
|
223
|
226
|
|
|
|
|
399
|
$self = _instance($self); |
|
224
|
226
|
|
|
|
|
502
|
my $bignum = $self->bignum; |
|
225
|
226
|
|
|
|
|
465
|
my $bigrat = $self->bigrat; |
|
226
|
226
|
|
|
|
|
440
|
my (@expr_queue, @oper_stack, $binop_possible); |
|
227
|
226
|
|
|
2
|
|
2175
|
while ($expr =~ /$token_re/g) { |
|
|
2
|
|
|
|
|
15
|
|
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
24
|
|
|
228
|
851
|
|
|
|
|
82085
|
my ($token, $octal) = ($1, $2); |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# Octal/hex/binary numbers |
|
231
|
851
|
50
|
33
|
|
|
1847
|
$token = oct $octal if defined $octal and length $octal; |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# Implicit multiplication |
|
234
|
851
|
100
|
100
|
|
|
2355
|
if ($binop_possible and $token ne ')' and $token ne ',' |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
235
|
|
|
|
|
|
|
and !defined _operator($token)) { |
|
236
|
11
|
|
|
|
|
27
|
_shunt_operator(\@expr_queue, \@oper_stack, '*'); |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
|
|
239
|
1
|
100
|
|
1
|
|
8
|
if (defined _operator($token)) { |
|
|
1
|
100
|
|
|
|
2
|
|
|
|
1
|
100
|
|
|
|
12
|
|
|
|
851
|
100
|
|
|
|
1488
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# Detect unary minus/plus |
|
241
|
262
|
50
|
66
|
|
|
612
|
if (!$binop_possible and ($token eq '-' or $token eq '+')) { |
|
|
|
|
100
|
|
|
|
|
|
242
|
23
|
|
|
|
|
51
|
$token = "u$token"; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
262
|
|
|
|
|
600
|
_shunt_operator(\@expr_queue, \@oper_stack, $token); |
|
245
|
262
|
100
|
|
|
|
1566
|
$binop_possible = $token eq '!' ? 1 : 0; |
|
246
|
|
|
|
|
|
|
} elsif ($token eq '(') { |
|
247
|
30
|
|
|
|
|
89
|
_shunt_left_paren(\@expr_queue, \@oper_stack); |
|
248
|
30
|
|
|
|
|
174
|
$binop_possible = 0; |
|
249
|
|
|
|
|
|
|
} elsif ($token eq ')') { |
|
250
|
30
|
100
|
|
|
|
76
|
_shunt_right_paren(\@expr_queue, \@oper_stack) |
|
251
|
|
|
|
|
|
|
or die "Mismatched parentheses\n"; |
|
252
|
29
|
|
|
|
|
179
|
$binop_possible = 1; |
|
253
|
|
|
|
|
|
|
} elsif ($token eq ',') { |
|
254
|
7
|
100
|
|
|
|
24
|
_shunt_comma(\@expr_queue, \@oper_stack) |
|
255
|
|
|
|
|
|
|
or die "Misplaced comma or mismatched parentheses\n"; |
|
256
|
6
|
|
|
|
|
62
|
$binop_possible = 0; |
|
257
|
|
|
|
|
|
|
} elsif (Scalar::Util::looks_like_number $token) { |
|
258
|
417
|
100
|
100
|
|
|
1521
|
$token = Math::BigFloat->new($token) if $bignum or $bigrat; |
|
259
|
417
|
|
|
|
|
10235
|
_shunt_number(\@expr_queue, \@oper_stack, $token); |
|
260
|
417
|
|
|
|
|
2334
|
$binop_possible = 1; |
|
261
|
|
|
|
|
|
|
} elsif ($token =~ m/\A\w+\z/) { |
|
262
|
104
|
100
|
|
|
|
295
|
die qq{Invalid function "$token"\n} unless exists $self->_functions->{$token}; |
|
263
|
100
|
100
|
|
|
|
219
|
if ($self->_functions->{$token}{args} > 0) { |
|
264
|
70
|
|
|
|
|
237
|
_shunt_function_with_args(\@expr_queue, \@oper_stack, $token); |
|
265
|
70
|
|
|
|
|
519
|
$binop_possible = 0; |
|
266
|
|
|
|
|
|
|
} else { |
|
267
|
30
|
|
|
|
|
103
|
_shunt_function_no_args(\@expr_queue, \@oper_stack, $token); |
|
268
|
30
|
|
|
|
|
161
|
$binop_possible = 1; |
|
269
|
|
|
|
|
|
|
} |
|
270
|
|
|
|
|
|
|
} else { |
|
271
|
1
|
|
|
|
|
6
|
die qq{Unknown token "$token"\n}; |
|
272
|
|
|
|
|
|
|
} |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# Leftover operators go at the end |
|
276
|
219
|
|
|
|
|
489
|
while (@oper_stack) { |
|
277
|
242
|
100
|
|
|
|
513
|
die "Mismatched parentheses\n" if $oper_stack[-1] eq '('; |
|
278
|
241
|
|
|
|
|
661
|
push @expr_queue, pop @oper_stack; |
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
218
|
|
|
|
|
663
|
return \@expr_queue; |
|
282
|
|
|
|
|
|
|
} |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub _shunt_number { |
|
285
|
417
|
|
|
417
|
|
742
|
my ($expr_queue, $oper_stack, $num) = @_; |
|
286
|
417
|
|
|
|
|
787
|
push @$expr_queue, $num; |
|
287
|
417
|
|
|
|
|
627
|
return 1; |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub _shunt_operator { |
|
291
|
273
|
|
|
273
|
|
490
|
my ($expr_queue, $oper_stack, $oper) = @_; |
|
292
|
273
|
|
|
|
|
457
|
my $oper_stat = _operator($oper); |
|
293
|
273
|
|
|
|
|
521
|
my $assoc = $oper_stat->{assoc}; |
|
294
|
273
|
|
100
|
|
|
713
|
while (@$oper_stack and defined _operator(my $top_oper = $oper_stack->[-1])) { |
|
295
|
97
|
100
|
100
|
|
|
467
|
if ($oper_stat->{lower_than}{$top_oper} |
|
|
|
|
100
|
|
|
|
|
|
296
|
|
|
|
|
|
|
or ($assoc eq 'left' and $oper_stat->{equal_to}{$top_oper})) { |
|
297
|
58
|
|
|
|
|
191
|
push @$expr_queue, pop @$oper_stack; |
|
298
|
|
|
|
|
|
|
} else { |
|
299
|
39
|
|
|
|
|
77
|
last; |
|
300
|
|
|
|
|
|
|
} |
|
301
|
|
|
|
|
|
|
} |
|
302
|
273
|
|
|
|
|
579
|
push @$oper_stack, $oper; |
|
303
|
273
|
|
|
|
|
460
|
return 1; |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub _shunt_function_with_args { |
|
307
|
70
|
|
|
70
|
|
143
|
my ($expr_queue, $oper_stack, $function) = @_; |
|
308
|
70
|
|
|
|
|
138
|
push @$oper_stack, $function; |
|
309
|
70
|
|
|
|
|
120
|
return 1; |
|
310
|
|
|
|
|
|
|
} |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub _shunt_function_no_args { |
|
313
|
30
|
|
|
30
|
|
77
|
my ($expr_queue, $oper_stack, $function) = @_; |
|
314
|
30
|
|
|
|
|
110
|
push @$expr_queue, $function; |
|
315
|
30
|
|
|
|
|
101
|
return 1; |
|
316
|
|
|
|
|
|
|
} |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub _shunt_left_paren { |
|
319
|
30
|
|
|
30
|
|
63
|
my ($expr_queue, $oper_stack) = @_; |
|
320
|
30
|
|
|
|
|
68
|
push @$oper_stack, '('; |
|
321
|
30
|
|
|
|
|
46
|
return 1; |
|
322
|
|
|
|
|
|
|
} |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub _shunt_right_paren { |
|
325
|
30
|
|
|
30
|
|
53
|
my ($expr_queue, $oper_stack) = @_; |
|
326
|
30
|
|
100
|
|
|
147
|
while (@$oper_stack and $oper_stack->[-1] ne '(') { |
|
327
|
23
|
|
|
|
|
98
|
push @$expr_queue, pop @$oper_stack; |
|
328
|
|
|
|
|
|
|
} |
|
329
|
30
|
100
|
66
|
|
|
124
|
return 0 unless @$oper_stack and $oper_stack->[-1] eq '('; |
|
330
|
29
|
|
|
|
|
42
|
pop @$oper_stack; |
|
331
|
29
|
100
|
66
|
|
|
158
|
if (@$oper_stack and $oper_stack->[-1] ne '(' |
|
|
|
|
100
|
|
|
|
|
|
332
|
|
|
|
|
|
|
and !defined _operator($oper_stack->[-1])) { |
|
333
|
|
|
|
|
|
|
# Not parentheses or operator, must be function |
|
334
|
18
|
|
|
|
|
37
|
push @$expr_queue, pop @$oper_stack; |
|
335
|
|
|
|
|
|
|
} |
|
336
|
29
|
|
|
|
|
86
|
return 1; |
|
337
|
|
|
|
|
|
|
} |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub _shunt_comma { |
|
340
|
7
|
|
|
7
|
|
19
|
my ($expr_queue, $oper_stack) = @_; |
|
341
|
7
|
|
100
|
|
|
42
|
while (@$oper_stack and $oper_stack->[-1] ne '(') { |
|
342
|
2
|
|
|
|
|
9
|
push @$expr_queue, pop @$oper_stack; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
7
|
100
|
66
|
|
|
80
|
return 0 unless @$oper_stack and $oper_stack->[-1] eq '('; |
|
345
|
6
|
|
|
|
|
22
|
return 1; |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub evaluate { |
|
349
|
206
|
|
|
206
|
1
|
323693
|
my ($self, $expr) = @_; |
|
350
|
206
|
|
|
|
|
375
|
$self = _instance($self); |
|
351
|
206
|
100
|
|
|
|
818
|
$expr = $self->parse($expr) unless ref $expr eq 'ARRAY'; |
|
352
|
|
|
|
|
|
|
|
|
353
|
203
|
100
|
|
|
|
429
|
die "No expression to evaluate\n" unless @$expr; |
|
354
|
|
|
|
|
|
|
|
|
355
|
202
|
|
|
|
|
444
|
my $bignum = $self->bignum; |
|
356
|
202
|
|
|
|
|
439
|
my $bigrat = $self->bigrat; |
|
357
|
202
|
|
|
|
|
295
|
my @eval_stack; |
|
358
|
202
|
|
|
|
|
391
|
foreach my $token (@$expr) { |
|
359
|
728
|
50
|
|
|
|
13415
|
die "Undefined token in evaluate\n" unless defined $token; |
|
360
|
728
|
100
|
|
|
|
1215
|
if (exists $self->_functions->{$token}) { |
|
|
|
100
|
|
|
|
|
|
|
361
|
342
|
|
|
|
|
516
|
my $function = $self->_functions->{$token}; |
|
362
|
342
|
|
|
|
|
629
|
my $num_args = $function->{args}; |
|
363
|
342
|
100
|
|
|
|
710
|
die "Malformed expression\n" if @eval_stack < $num_args; |
|
364
|
340
|
100
|
|
|
|
846
|
my @args = $num_args > 0 ? splice @eval_stack, -$num_args : (); |
|
365
|
340
|
|
|
|
|
566
|
my $code = $function->{code}; |
|
366
|
340
|
100
|
100
|
|
|
1537
|
$code = $function->{bignum_code} if ($bignum or $bigrat) and defined $function->{bignum_code}; |
|
|
|
|
100
|
|
|
|
|
|
367
|
340
|
100
|
100
|
|
|
687
|
$code = $function->{bigrat_code} if $bigrat and defined $function->{bigrat_code}; |
|
368
|
340
|
|
|
|
|
488
|
my ($result, $errored, $error); |
|
369
|
|
|
|
|
|
|
{ |
|
370
|
340
|
|
|
|
|
417
|
local $@; |
|
|
340
|
|
|
|
|
569
|
|
|
371
|
340
|
100
|
|
|
|
541
|
unless (eval { $result = $code->(@args); 1 }) { |
|
|
340
|
|
|
|
|
774
|
|
|
|
336
|
|
|
|
|
1302153
|
|
|
372
|
4
|
|
|
|
|
7
|
$errored = 1; |
|
373
|
4
|
|
|
|
|
7
|
$error = $@; |
|
374
|
|
|
|
|
|
|
} |
|
375
|
|
|
|
|
|
|
} |
|
376
|
340
|
100
|
|
|
|
701
|
if ($errored) { |
|
377
|
4
|
50
|
|
|
|
8
|
$error = '' unless defined $error; |
|
378
|
4
|
|
|
|
|
25
|
$error =~ s/ at .+? line \d+\.$//i; |
|
379
|
4
|
|
|
|
|
7
|
chomp $error; |
|
380
|
4
|
|
|
|
|
61
|
die qq{Error in function "$token": $error\n}; |
|
381
|
|
|
|
|
|
|
} |
|
382
|
336
|
100
|
|
|
|
631
|
die qq{Undefined result from function "$token"\n} unless defined $result; |
|
383
|
|
|
|
|
|
|
{ |
|
384
|
8
|
|
|
8
|
|
96
|
no warnings 'numeric'; |
|
|
8
|
|
|
|
|
19
|
|
|
|
8
|
|
|
|
|
3039
|
|
|
|
335
|
|
|
|
|
464
|
|
|
385
|
335
|
|
|
|
|
939
|
push @eval_stack, $result+0; |
|
386
|
|
|
|
|
|
|
} |
|
387
|
|
|
|
|
|
|
} elsif (Scalar::Util::looks_like_number $token) { |
|
388
|
385
|
|
|
|
|
6197
|
push @eval_stack, $token; |
|
389
|
|
|
|
|
|
|
} else { |
|
390
|
1
|
|
|
|
|
5
|
die qq{Invalid function "$token"\n}; |
|
391
|
|
|
|
|
|
|
} |
|
392
|
|
|
|
|
|
|
} |
|
393
|
|
|
|
|
|
|
|
|
394
|
194
|
100
|
|
|
|
19417
|
die "Malformed expression\n" if @eval_stack > 1; |
|
395
|
|
|
|
|
|
|
|
|
396
|
193
|
|
|
|
|
1077
|
return $eval_stack[0]; |
|
397
|
|
|
|
|
|
|
} |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub try_evaluate { |
|
400
|
9
|
|
|
9
|
1
|
878
|
my ($self, $expr) = @_; |
|
401
|
9
|
|
|
|
|
23
|
$self = _instance($self); |
|
402
|
9
|
|
|
|
|
43
|
delete $self->{error}; |
|
403
|
9
|
|
|
|
|
18
|
undef $ERROR; |
|
404
|
9
|
|
|
|
|
12
|
local $@; |
|
405
|
9
|
|
|
|
|
13
|
my $result; |
|
406
|
9
|
100
|
|
|
|
16
|
unless (eval { $result = $self->evaluate($expr); 1 }) { |
|
|
9
|
|
|
|
|
19
|
|
|
|
3
|
|
|
|
|
9
|
|
|
407
|
6
|
|
|
|
|
17
|
chomp(my $error = $@); |
|
408
|
6
|
|
|
|
|
13
|
$self->{error} = $ERROR = $error; |
|
409
|
6
|
|
|
|
|
31
|
return undef; |
|
410
|
|
|
|
|
|
|
} |
|
411
|
3
|
|
|
|
|
14
|
return $result; |
|
412
|
|
|
|
|
|
|
} |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
1; |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=encoding utf8 |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head1 NAME |
|
419
|
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Math::Calc::Parser - Parse and evaluate mathematical expressions |
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
use Math::Calc::Parser 'calc'; |
|
425
|
|
|
|
|
|
|
use utf8; # for π in source code |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
my $result = calc '2 + 2'; # 4 |
|
428
|
|
|
|
|
|
|
my $result = calc 'int rand 5'; # Random integer between 0 and 4 |
|
429
|
|
|
|
|
|
|
my $result = calc 'sqrt -1'; # i |
|
430
|
|
|
|
|
|
|
my $result = calc '0xff << 2'; # 1020 |
|
431
|
|
|
|
|
|
|
my $result = calc '1/0'; # Division by 0 exception |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
# Class methods |
|
434
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->evaluate('2 + 2'); # 4 |
|
435
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->evaluate('3π^2'); # 29.608813203268 |
|
436
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->evaluate('0.7(ln 4)'); # 0.970406052783923 |
|
437
|
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# With more advanced error handling |
|
439
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->try_evaluate('rand(abs'); # undef (Mismatched parentheses) |
|
440
|
|
|
|
|
|
|
if (defined $result) { |
|
441
|
|
|
|
|
|
|
print "Result: $result\n"; |
|
442
|
|
|
|
|
|
|
} else { |
|
443
|
|
|
|
|
|
|
print "Error: ".Math::Calc::Parser->error."\n"; |
|
444
|
|
|
|
|
|
|
} |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# Or as an object for more control |
|
447
|
|
|
|
|
|
|
my $parser = Math::Calc::Parser->new; |
|
448
|
|
|
|
|
|
|
$parser->add_functions(triple => { args => 1, code => sub { $_[0]*3 } }); |
|
449
|
|
|
|
|
|
|
$parser->add_functions(pow => { args => 2, code => sub { $_[0] ** $_[1] }); |
|
450
|
|
|
|
|
|
|
$parser->add_functions(one => sub { 1 }, two => sub { 2 }, three => sub { 3 }); |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
my $result = $parser->evaluate('2(triple one)'); # 2*(1*3) = 6 |
|
453
|
|
|
|
|
|
|
my $result = $parser->evaluate('pow(triple two, three)'); # (2*3)^3 = 216 |
|
454
|
|
|
|
|
|
|
my $result = $parser->try_evaluate('triple triple'); # undef (Malformed expression) |
|
455
|
|
|
|
|
|
|
die $parser->error unless defined $result; |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$parser->remove_functions('π', 'e'); |
|
458
|
|
|
|
|
|
|
$parser->evaluate('3π'); # Invalid function exception |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# Arbitrary precision calculations - use only in a controlled environment |
|
461
|
|
|
|
|
|
|
$parser->bignum(1); |
|
462
|
|
|
|
|
|
|
my $result = $parser->evaluate('30!'); # 265252859812191058636308480000000 |
|
463
|
|
|
|
|
|
|
my $result = $parser->evaluate('atan pi'); # 1.262627255678911683444322083605698343509 |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Rational number calculations - use only in a controlled environment |
|
466
|
|
|
|
|
|
|
$parser->bigrat(1); |
|
467
|
|
|
|
|
|
|
my $result = $parser->evaluate('3 / 9'); # 1/3 |
|
468
|
|
|
|
|
|
|
my $result = $parser->evaluate('3 >> 2'); # 3/4 |
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
L is a simplified mathematical expression evaluator with |
|
473
|
|
|
|
|
|
|
support for complex and trigonometric operations, implicit multiplication, and |
|
474
|
|
|
|
|
|
|
perlish "parentheses optional" functions, while being safe for arbitrary user |
|
475
|
|
|
|
|
|
|
input. It parses input strings into a structure based on |
|
476
|
|
|
|
|
|
|
L |
|
477
|
|
|
|
|
|
|
(RPN), and then evaluates the result. The list of recognized functions may be |
|
478
|
|
|
|
|
|
|
customized using L"add_functions"> and L"remove_functions">. |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=head1 FUNCTIONS |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=head2 calc |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
use Math::Calc::Parser 'calc'; |
|
485
|
|
|
|
|
|
|
my $result = calc '2+2'; |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
$ perl -MMath::Calc::Parser=calc -E 'say calc "2+2"' |
|
488
|
|
|
|
|
|
|
$ perl -Math -e '2+2' |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
Compact exportable function wrapping L"evaluate"> for string expressions. |
|
491
|
|
|
|
|
|
|
Throws an exception on error. See L for easy compact one-liners. |
|
492
|
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
These attributes can only be set on instantiated objects. |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=head2 bignum |
|
498
|
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my $bool = $parser->bignum; |
|
500
|
|
|
|
|
|
|
$parser = $parser->bignum($bool); |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Enable support for arbitrary precision numbers using L and |
|
503
|
|
|
|
|
|
|
L. This will avoid losing precision when working with floats or |
|
504
|
|
|
|
|
|
|
large integers, but see L"BIGNUM CAVEATS">. |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=head2 bigrat |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my $bool = $parser->bigrat; |
|
509
|
|
|
|
|
|
|
$parser = $parser->bigrat($bool); |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Enable support for precise rational numbers using L. This will |
|
512
|
|
|
|
|
|
|
avoid losing precision when working with integer divison and similar |
|
513
|
|
|
|
|
|
|
operations, and will result in output like C<3/7> where possible, but see |
|
514
|
|
|
|
|
|
|
L"BIGNUM CAVEATS">. |
|
515
|
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=head1 METHODS |
|
517
|
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
Aside from C and C, all methods can be called |
|
519
|
|
|
|
|
|
|
as class methods, and will act on a singleton object with the default functions |
|
520
|
|
|
|
|
|
|
available. |
|
521
|
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head2 new |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
my $parser = Math::Calc::Parser->new; |
|
525
|
|
|
|
|
|
|
my $parser = Math::Calc::Parser->new(bignum => 1); |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
Creates a new L object. |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
=head2 parse |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
my $parsed = Math::Calc::Parser->parse('5 / e^(i*pi)'); |
|
532
|
|
|
|
|
|
|
my $parsed = $parser->parse('3pi'); |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Parses a mathematical expression. On success, returns an array reference |
|
535
|
|
|
|
|
|
|
representation of the expression in RPN notation which can be passed to |
|
536
|
|
|
|
|
|
|
L"evaluate">. Throws an exception on failure. |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=head2 evaluate |
|
539
|
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->evaluate($parsed); |
|
541
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->evaluate('log rand 7'); |
|
542
|
|
|
|
|
|
|
my $result = $parser->evaluate('round 13/3'); |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Evaluates a mathematical expression. The argument can be either an arrayref |
|
545
|
|
|
|
|
|
|
from L"parse"> or a string expression which will be passed to L"parse">. |
|
546
|
|
|
|
|
|
|
Returns the result of the expression on success or throws an exception on |
|
547
|
|
|
|
|
|
|
failure. |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head2 try_evaluate |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
if (defined (my $result = Math::Calc::Parser->try_evaluate('floor 2.5'))) { |
|
552
|
|
|
|
|
|
|
print "Result: $result\n"; |
|
553
|
|
|
|
|
|
|
} else { |
|
554
|
|
|
|
|
|
|
print "Error: ".Math::Calc::Parser->error."\n"; |
|
555
|
|
|
|
|
|
|
} |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
if (defined (my $result = $parser->try_evaluate('log(5'))) { |
|
558
|
|
|
|
|
|
|
print "Result: $result\n"; |
|
559
|
|
|
|
|
|
|
} else { |
|
560
|
|
|
|
|
|
|
print "Error: ".$parser->error."\n"; |
|
561
|
|
|
|
|
|
|
} |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Same as L"evaluate"> but instead of throwing an exception on failure, returns |
|
564
|
|
|
|
|
|
|
undef. The L"error"> method can then be used to retrieve the error message. |
|
565
|
|
|
|
|
|
|
The error message for the most recent L"try_evaluate"> call can also be |
|
566
|
|
|
|
|
|
|
retrieved from the package variable C<$Math::Calc::Parser::ERROR>. |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=head2 error |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
my $result = Math::Calc::Parser->try_evaluate('(i'); |
|
571
|
|
|
|
|
|
|
die Math::Calc::Parser->error unless defined $result; |
|
572
|
|
|
|
|
|
|
my $result = $parser->try_evaluate('2//'); |
|
573
|
|
|
|
|
|
|
die $parser->error unless defined $result; |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
Returns the error message after a failed L"try_evaluate">. |
|
576
|
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=head2 add_functions |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
$parser->add_functions( |
|
580
|
|
|
|
|
|
|
my_function => { args => 5, code => sub { return grep { $_ > 0 } @_; } }, |
|
581
|
|
|
|
|
|
|
other_function => sub { 20 }, |
|
582
|
|
|
|
|
|
|
bignum_function => { args => 1, code => sub { 2 ** $_[0] }, bignum_code => sub { Math::BigInt->new(2)->bpow($_[0]) } }, |
|
583
|
|
|
|
|
|
|
); |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Adds functions to be recognized by the parser object. Keys are function names |
|
586
|
|
|
|
|
|
|
which must start with an alphabetic character and consist only of |
|
587
|
|
|
|
|
|
|
L. |
|
588
|
|
|
|
|
|
|
Values are either a hashref containing C and C keys, or a coderef |
|
589
|
|
|
|
|
|
|
that is assumed to be a 0-argument function. C must be an integer greater |
|
590
|
|
|
|
|
|
|
than or equal to C<0>. C or the passed coderef will be called with the |
|
591
|
|
|
|
|
|
|
numeric operands passed as parameters, and must either return a numeric result |
|
592
|
|
|
|
|
|
|
or throw an exception. Non-numeric results will be cast to numbers in the usual |
|
593
|
|
|
|
|
|
|
perl fashion, and undefined results will throw an evaluation error. |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Alternate implementations to be used when L"bignum"> or L"bigrat"> is |
|
596
|
|
|
|
|
|
|
enabled can be passed as C and C respectively. |
|
597
|
|
|
|
|
|
|
C will also be used for L"bigrat"> calculations if |
|
598
|
|
|
|
|
|
|
C is not separately defined; it is not common that these will need |
|
599
|
|
|
|
|
|
|
separate implementations. |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=head2 remove_functions |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$parser->remove_functions('rand','nonexistent'); |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Removes functions from the parser object if they exist. Can be used to remove |
|
606
|
|
|
|
|
|
|
default functions as well as functions previously added with |
|
607
|
|
|
|
|
|
|
L"add_functions">. |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=head1 OPERATORS |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
L recognizes the following operators with their usual |
|
612
|
|
|
|
|
|
|
mathematical definitions. |
|
613
|
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
+, -, *, /, %, ^, !, <<, >> |
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
Note: C<+> and C<-> can represent both binary addition/subtraction and unary |
|
617
|
|
|
|
|
|
|
negation. |
|
618
|
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=head1 DEFAULT FUNCTIONS |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
L parses several functions by default, which can be |
|
622
|
|
|
|
|
|
|
customized using L"add_functions"> or L"remove_functions"> on an object |
|
623
|
|
|
|
|
|
|
instance. |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=over |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=item abs |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Absolute value. |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=item acos |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=item asin |
|
634
|
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=item atan |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
Inverse sine, cosine, and tangent. |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item atan2 |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Two-argument inverse tangent of first argument divided by second argument. |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=item ceil |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
Round up to nearest integer. |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=item cos |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Cosine. |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item e |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Euler's number. |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=item floor |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Round down to nearest integer. |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=item i |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Imaginary unit. |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item int |
|
664
|
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Cast (truncate) to integer. |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=item ln |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Natural log. |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=item log |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
Log base 10. |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=item logn |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
Log with arbitrary base given as second argument. |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=item pi |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
π |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=item π |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
π (this must be the decoded Unicode character) |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=item rand |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Random value between 0 and 1 (exclusive of 1). Uses L if |
|
690
|
|
|
|
|
|
|
installed. |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item round |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Round to nearest integer, with halfway cases rounded away from zero. Due to |
|
695
|
|
|
|
|
|
|
bugs in L, precision may be lost with L"bigrat"> enabled. |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=item sin |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
Sine. |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=item sqrt |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
Square root. |
|
704
|
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=item tan |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Tangent. |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=back |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head1 CAVEATS |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
While parentheses are optional for functions with 0 or 1 argument, they are |
|
714
|
|
|
|
|
|
|
required when a comma is used to separate multiple arguments. |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
Due to the nature of handling complex numbers, the evaluated result may be a |
|
717
|
|
|
|
|
|
|
L object. These objects can be directly printed or used in |
|
718
|
|
|
|
|
|
|
numeric operations but may be more difficult to use in comparisons. |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Operators that are not defined to operate on complex numbers will return the |
|
721
|
|
|
|
|
|
|
result of the operation on the real components of their operands. This includes |
|
722
|
|
|
|
|
|
|
the operators CE>, CE>, C<%>, and C. |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=head1 BIGNUM CAVEATS |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
The L, L, and L packages are useful |
|
727
|
|
|
|
|
|
|
for working with numbers without losing precision, and can be used by this |
|
728
|
|
|
|
|
|
|
module by setting the L"bignum"> or L"bigrat"> attributes, but care should |
|
729
|
|
|
|
|
|
|
be taken. They will perform significantly slower than native Perl numbers, and |
|
730
|
|
|
|
|
|
|
can result in an operation that does not terminate or one that uses up all your |
|
731
|
|
|
|
|
|
|
memory. |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Additionally, similar to when using the L or L pragmas, the |
|
734
|
|
|
|
|
|
|
auto-upgrading and downgrading behavior of these modules can only be set |
|
735
|
|
|
|
|
|
|
globally, so enabling these options will affect all other uses of these modules |
|
736
|
|
|
|
|
|
|
in your program. For the same reason, it is not recommended to enable both |
|
737
|
|
|
|
|
|
|
L"bignum"> and L"bigrat"> in the same program. |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
The evaluated result may be a L, L, |
|
740
|
|
|
|
|
|
|
L, or other similar type of object. These objects can be printed |
|
741
|
|
|
|
|
|
|
and behave normally as numbers. |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
L defaults to rounding values at 40 digits in division. This |
|
744
|
|
|
|
|
|
|
can be controlled by setting the global L, |
|
745
|
|
|
|
|
|
|
but may have a large impact on performance and memory usage. |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
Complex math is incompatible with L"bignum"> and L"bigrat"> and will likely |
|
748
|
|
|
|
|
|
|
result in NaN. |
|
749
|
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=head1 BUGS |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
Report any issues on the public bugtracker. |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head1 AUTHOR |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Dan Book, C |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Copyright 2015, Dan Book. |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
This library is free software; you may redistribute it and/or modify it under |
|
763
|
|
|
|
|
|
|
the terms of the Artistic License version 2.0. |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
L |