Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

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
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2018-06-21 05:13 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (117 votes). Check out past polls.