Polish Prefix Calculator

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.
[download]

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;
    }
    print "\nANSWER: ".$given."\n\n";
}
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)
                                        \)
                        /$+{leading}\($+{op}\ $+{nums}\)\)/x;
}
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;
}
[download]

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

Comment on Polish Prefix Calculator Select or Download Code

Replies are listed 'Best First'.
Re: Polish Prefix Calculator by jwkrahn (Abbot) 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($){` [download] 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){` [download] 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/;` [download] 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); } [download] 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; }` [download] Update: this is how I would probably do it: <Reveal this spoiler or all in this thread>	[reply] [d/l] [select]
Re^2: Polish Prefix Calculator by protist (Monk) on Oct 04, 2012 at 07:04 UTC
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/()//	[reply]
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	[reply]
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.	[reply] [d/l] [select]
Re^2: Polish Prefix Calculator by protist (Monk) on Oct 05, 2012 at 05:31 UTC
++ 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.` [download] As a matter of good practice and efficiency, I use ++ wherever possible. I do the same with *+	[reply] [d/l]
Re^3: Polish Prefix Calculator by Anonymous Monk on Oct 05, 2012 at 05:45 UTC
Thanks for the explanation. (Note to self: possessive quantifiers were introduced in perl 5.9.5.)	[reply]