#!/usr/bin/perl 
use strict;
use warnings;
use Data::Dumper;
# this code can be re-written without any regex/eval,their use is pure
+ly for shortening the code


use constant BASE_PRIORITY => 
{
    NUMBER        => 2,
    OPEN_PARA    => 8,
    CLOSED_PARA => 8,
    ADD            => 4,
    SUB            => 4,
    MUL            => 7,
    DIV            => 7,
    POW            => 9,
};

use constant DEPTH_BONUS => 10;


#my $exp = "5*(12/(32+4))-10";
my $exp = "3**(6-1*4)**2";

#my $exp = -3+(-1-2);
#my $exp = (3-(4+6))/2;

my $depth = 0;
my @terms;



sub delete_at { # delete the term at the index equal to the parameter 
+given to this function
    return shift @terms if $_[0] == 0;
    return pop @terms if $_[0] == (@terms-1);
    my $ret = $terms[ $_[0] ];
    @terms = (
        @terms[0..$_[0]-1],
        @terms[$_[0]+1..@terms-1],
    );
    return $ret;
}

sub insert_at { # inserts a term exactly before the index given as par
+ameter
    @terms = (
        @terms[0..$_[0]-1],
        $_[1],
        @terms[$_[0]..@terms-1],
    );

}


sub firstPass {# this builds up the @terms for later use
    while( $exp =~ s/^(\-?\d+|\*\*|\*|\/|\+|\-|\(|\))// ) {
        my $type=$1;
        my $term=$1;
        if( @terms>0 &&  $terms[@terms - 1 ]->{type} eq 'NUMBER' && $t
+erm =~ /\-\d+/ ) {
            #see if we currently have a negative number,see if before 
+we had a number
            #this means that we're on the wrong track and that - is ac
+tually an operator here
            #and not the sign for a negative number
            $exp=$term.$exp;
            $exp=~s/^-//;
            $type = "SUB";
            $term = '-';
            print "EXP $exp \n";
        } else {
            $type =~ s/\-?\d+/NUMBER/;
        };
        $type =~ s/\(/OPEN_PARA/;
        $type =~ s/\)/CLOSED_PARA/;
        $type =~ s/\+/ADD/;
        $type =~ s/\*\*/POW/;
        $type =~ s/\*/MUL/;
        $type =~ s/\//DIV/;
        $type =~ s/\-$/SUB/;
        my ($is_term_para) = $type =~ /OPEN_PARA|CLOSED_PARA/; # this 
+flag will tell us wether the term is or is not a paranthesis 
        $depth++ if $type eq 'OPEN_PARA';  # if we encounter an open p
+aranthesis we increase depth
        $depth-- if $type eq 'CLOSED_PARA';# closed paranthesis we dec
+rease it
        push @terms,
        {
            type        => $type,
            term        => $term,
            priority    => BASE_PRIORITY->{$type} + $depth*DEPTH_BONUS
        }
        unless $is_term_para; # we leave out the paranthesis because w
+e no longer need them(their purpose
                              # was to provide priority information fo
+r us)
    };
}


sub getPrioritary { # gets most prioritary 3 elements in the current e
+xpression

    my @sIndexes = sort { -1 * ( $terms[$a]->{priority} <=> $terms[$b]
+->{priority} ); } 0..(@terms-1) ;

    my $i = 0; # the index in @sIndexes
    my $middleMaxPrio = $sIndexes[$i];

    while( $terms[$middleMaxPrio]->{type} eq 'NUMBER' ) { # if our sel
+ected maximum priority element is not a number search for the next mo
+st prioritized that is a number
        print "[DEBUG] $terms[$middleMaxPrio]->{type}";
        $middleMaxPrio = $sIndexes[++$i];
    };

    my $leftNearMax      = $middleMaxPrio -1; # we take the left of $m
+iddleMaxPrio
    my $rightNearMax  = $middleMaxPrio +1; # and the right of it , bec
+uase these two are surely operands

    my @selectedTerms = map { delete_at $_  } ( $rightNearMax , $middl
+eMaxPrio , $leftNearMax ); # we delete them in inverse order to not a
+lter the stack badly

    return {
        selected    => [ @selectedTerms ],
        insertIndex    => $leftNearMax,
        maxPriority    => $selectedTerms[1]->{priority}, # the middle 
+element will be surely an operator so it will have maximum priority
    };
}


#---------------------------------------------------------------------
+------------------------------------------------

firstPass;

while( @terms > 1 ) {
    print "DEBUG ".Dumper [@terms];

    my $data = getPrioritary;
    my @elems = map { $_->{term} } @{ $data->{selected} };
    my $expr = sprintf "%s %s %s", reverse @elems;
    my $result = eval($expr); # the eval here has just been used for s
+hortening the code,it could have very well been a simple switch on $e
+lems[1]

    print "DEBUG [$expr]\n";

    insert_at 
    $data->{insertIndex},
    {
        type    => 'NUMBER',
        term    => $result,
        priority=> $data->{maxPriority} - DEPTH_BONUS #we have calcula
+ted what was probably a paranthesis therefore we substrac a depth_bon
+us
    };
    <>;
};

print "RESULT :".$terms[0]->{term};
[download]