Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

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; } 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; }

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.


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.)

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://997089]
Approved by kcott
[Discipulus]: morning marto!

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (9)
As of 2017-02-22 09:32 GMT
Find Nodes?
    Voting Booth?
    Before electricity was invented, what was the Electric Eel called?

    Results (325 votes). Check out past polls.