Perl Monk, Perl Meditation PerlMonks

### Polish Prefix Calculator

by protist (Monk)
 on Oct 03, 2012 at 16:25 UTC ( #997089=CUFP: print w/replies, xml ) Need Help??

This is a calculator using polish prefix notation with parentheses. It will properly parse and calculate when given input such as:

```(+ 1 2 3 (* 4 3 (- 2 1) (% 5 2)) 3 4)
#NOTE: % is the modulo operator, / is for dividing.

It can do this, because I implemented it using recursive ascent parsing. If you want to try it, I would recommend running it in verbose mode to see what it is doing. You can do this by putting a space followed by 1,v,V,verbose,VERBOSE, or similar after the program name when you run it. Enjoy.

```#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump qw(dump);
sub arith;
sub solvepart(\$);
sub testiterations;
sub reformat;
my \$VERBOSE=shift//0;
my \$MAXITERATIONS=500;
my \$iterations;
my @stack;
my \$num=qr/(-?\d++\.?\d*?)/;
while(<>){
\$iterations=0;
my \$given = \$_;
if (\$given ~~ /exit|end|quit/i){
die "PROGRAM TERMINATED\n";
}
if (\$given !~ /^(\((?:[^()]++|(?-1))*+\))/){
die "IMPROPER INPUT\n";
}
until (\$given !~ /[()]/){
reformat \$given;
\$given =~ s/(.*)(\(\S++ ++\$num ++(\$num)?\))/\$1.solvepart(\$2)/e
+;
testiterations;
}
}
sub testiterations{
\$iterations++;
if (\$iterations==\$MAXITERATIONS){
die "MAX ITERATIONS ACHIEVED: ABORTING\n";
}
}
sub reformat(\$){
1 while \$_[0] =~        s/(?<leading>   \((?<op>\S++)\s++\$num [^()]*?\
+s++)
(?<nums>\$num\s++\$num)
\)
}
sub solvepart(\$){
my \$given = shift;
unshift(@stack, [\$2,\$3,\$4]) while \$given =~ s/(.*)\((\S++) ++(-?\d
+++\.?\d*?) ++(-?\d++\.?\d*?)?\)/\$1/;
if (\$VERBOSE or \$VERBOSE ~~ /v(?:erbose)?/i){
print "\nDATA:\n";
dump @stack;
}
return arith;
}
sub arith{
my \$value=0;
while(@stack){
#my @level = map{handleneg(\$_)}@{pop @stack};
my @level = @{pop @stack};
if (\$level[0]eq'+'){
\$level[2]
?(\$value=\$level[1]+\$level[2])
:(\$value+=\$level[1]);
}
elsif (\$level[0]eq'-'){
\$level[2]
?(\$value=\$level[1]-\$level[2])
:(\$value=\$level[1]-\$value);
}
elsif (\$level[0]eq'/'){
\$level[2]
?(\$value=\$level[1]/\$level[2])
:(\$value=\$level[1]/\$value);
}
elsif (\$level[0]eq'*'){
\$level[2]
?(\$value=\$level[1]*\$level[2])
:(\$value*=\$level[1]);
}
elsif (\$level[0]eq'**'or\$level[0]eq'^'){
\$level[2]
?(\$value=\$level[1]**\$level[2])
:(\$value=\$level[1]**\$value);
}
elsif (\$level[0]eq'%'){
\$level[2]
?(\$value=\$level[1] % \$level[2])
:(\$value=\$level[1] % \$value);
}
else {
die "IMPROPER INPUT\n";
}
}
return \$value;
}

You can exit by inputing eXiT, end, QUIT, or similar.

Replies are listed 'Best First'.
Re: Polish Prefix Calculator
by jwkrahn (Monsignor) on Oct 03, 2012 at 22:13 UTC

First, it doesn't seem to work correctly.    I tried with the expression (+ 1 2 3 (* 4 3 (- 20 1) (% 5 2)) 3 4) and got the answer 2221 when it should be 241.

```sub solvepart(\$);
...
sub reformat;
...
sub reformat(\$){
...
sub solvepart(\$){

The declaration for reformat doesn't have a prototype but the definition does even though reformat does not accept any arguments    YOU SHOULD NOT USE PROTOTYPES.

```    if (\$given ~~ /(?:exit)|(?:end)|(?:quit)/i){
...
if (\$VERBOSE or \$VERBOSE ~~ /v(?:erbose)?/i){

Is there any good reason to use the smartmatch operator (~~) instead of the binding operator (=~)?    /(?:exit)|(?:end)|(?:quit)/i could be written more simply as /exit|end|quit/i.

```my \$num=qr/(-?\d++\.?\d*?)/;
...
unshift(@stack, [\$2,\$3,\$4]) while \$given =~ s/(.*)\((\S++) ++(-?\d
+++\.?\d*?) ++(-?\d++\.?\d*?)?\)/\$1/;

Why define \$num if you are not going to use it?

```        if (\$level[0]eq'+'){
\$level[2]
?(\$value=\$level[1]+\$level[2])
:(\$value+=\$level[1]);
}
elsif (\$level[0]eq'-'){
\$level[2]
?(\$value=\$level[1]-\$level[2])
:(\$value=\$level[1]-\$value);
}
elsif (\$level[0]eq'/'){
\$level[2]
?(\$value=\$level[1]/\$level[2])
:(\$value=\$level[1]/\$value);
}
elsif (\$level[0]eq'*'){
\$level[2]
?(\$value=\$level[1]*\$level[2])
:(\$value*=\$level[1]);
}
elsif (\$level[0]eq'**'or\$level[0]eq'^'){
\$level[2]
?(\$value=\$level[1]**\$level[2])
:(\$value=\$level[1]**\$value);
}
elsif (\$level[0]eq'%'){
\$level[2]
?(\$value=\$level[1] % \$level[2])
:(\$value=\$level[1] % \$value);
}

Could be written more simply as:

```        if (\$level[0]eq'+'){
\$value = \$level[1] + \$level[2] || \$value;
}
elsif (\$level[0]eq'-'){
\$value = \$level[1] - \$level[2] || \$value;
}
elsif (\$level[0]eq'/'){
\$value = \$level[1] / \$level[2] || \$value;
}
elsif (\$level[0]eq'*'){
\$value = \$level[1] * \$level[2] || \$value;
}
elsif (\$level[0]eq'**'or\$level[0]eq'^'){
\$value = \$level[1] ** \$level[2] || \$value;
}
elsif (\$level[0]eq'%'){
\$value = \$level[1] % \$level[2] || \$value;
}

Update: this is how I would probably do it:

I edited the reformat subroutine so that it now properly handles the input you described. Thank you for pointing out that bug. :)

I can see no reason to not (italics) use ~~

Whenever I put \$num in that particular line of code, it would store \$4 in \$3 for some reason. Eventually since I already had it written and working, I decided to not fix what wasn't broken. Maybe I'll change it later.

I removed the useless (?:) groupings you described. It is worth mentioning that my regex for verbose contains redundancies, but intentionally so for the sake of being explicit.

I like your eval join part, but I think you will find the parsing this problem requires is much more involved than tr/()//

Re: Polish Prefix Calculator
by MidLifeXis (Monsignor) on Oct 03, 2012 at 17:01 UTC

I believe that you have confused something similar to an S-Expression with polish notation. Cool, none the less, but not polish notation. Mathematical operations are binary, not N-ary.

Update: Possibly a distinction is being made in my mind where one should not be.

--MidLifeXis

Re: Polish Prefix Calculator
by Anonymous Monk on Oct 04, 2012 at 21:38 UTC

What does "++", instead of "+", do in regex parts in the matching portion without /e?

If you are going to use smartmatch, then should mention the minimum perl version for default use. It was not available as any other operator, say "~", without use v5.10.1; in perl 5.10.

++ matches possessively. This means that it will hold on to what it finds and not backtrack if the match fails with the current amount of matching handled by ++.

Contrast this with A+, where it will attempt a match of a maximum amount of As, then if the match fails, an A will be "given up" by A+, and a match will be attempted again with one less A. In the case of a failing match, if ++ will suit your needs, ++ is often many times more efficient (faster at failing when it does fail to match).

In some cases, the difference between + and ++ is trivial. In other cases they are not logically equivalent. Such as in:

```/A++A/ and /A+A/

# /A++A/ should never find a match, as A++ prevents A from being match
+ed after it.

As a matter of good practice and efficiency, I use ++ wherever possible. I do the same with *+

Thanks for the explanation. (Note to self: possessive quantifiers were introduced in perl 5.9.5.)

Create A New User
Node Status?
node history
Node Type: CUFP [id://997089]
Approved by kcott
help
Chatterbox?
and monks are getting baked in the sun...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2017-08-22 10:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Who is your favorite scientist and why?

Results (333 votes). Check out past polls.

Notices?