add rpn tokenizer

1 files changed, 57 insertions, 2 deletions

diff --git a/challenge-143/james-smith/perl/ch-1.pl b/challenge-143/james-smith/perl/ch-1.pl
index a4abfdeaab..2b0c32a29a 100644
--- a/challenge-143/james-smith/perl/ch-1.pl
+++ b/challenge-143/james-smith/perl/ch-1.pl
@@ -8,6 +8,22 @@ use Test::More;
 use Benchmark qw(cmpthese timethis);
 use Data::Dumper qw(Dumper);
 
+my(@s,@o);
+
+## List of operators - Entries in each array are:
+##  * precedence of operator
+##  * function to be run when finding operator in infix stream
+##  * function to be run when finding operator in rpn stream
+
+my %f;
+%f = (
+  '('=>[0,sub{push@s,'(' },                                                       ],
+  ')'=>[0,sub{push@o,$_ while($_=pop@s)ne'('},                                    ],
+  '*'=>[2,sub{push@o,pop@s while@s&&$f{$s[-1]}[0]>1;push@s,'*'},sub{$s[-2]*=pop@s}],
+  '+'=>[1,sub{push@o,pop@s while@s&&$f{$s[-1]}[0];  push@s,'+'},sub{$s[-2]+=pop@s}],
+  '-'=>[1,sub{push@o,pop@s while@s&&$f{$s[-1]}[0];  push@s,'-'},sub{$s[-2]-=pop@s}],
+);
+
 my @TESTS = (
   [ '10 + 20 - 5', 25 ],
   [ '(10 + 20 - 5) * 2', 50 ],
@@ -17,10 +33,14 @@ my @TESTS = (
   [ '(10 + 10) * (10 - 10) * (10 + 10) * (20 - (((20))))', 0 ],
 );
 
-is( evaluate($_->[0]), $_->[1] ) foreach @TESTS;
-is( eval(    $_->[0]), $_->[1] ) foreach @TESTS;
+is( evaluate(        $_->[0]), $_->[1] ) foreach @TESTS;
+is( evaluate_via_rpn($_->[0]), $_->[1] ) foreach @TESTS;
+is( evaluate_rpn_hsh($_->[0]), $_->[1] ) foreach @TESTS;
+is( eval(            $_->[0]), $_->[1] ) foreach @TESTS;
 cmpthese( 20000, {
   'evaluate' => sub { evaluate($_->[0]) for @TESTS },
+  'eval_rpn' => sub { evaluate_via_rpn($_->[0]) for @TESTS },
+  'eval_hsh' => sub { evaluate_rpn_hsh($_->[0]) for @TESTS },
   'eval'     => sub { eval(    $_->[0]) for @TESTS },
 });
 done_testing();
@@ -33,3 +53,38 @@ sub evaluate  {
   return $str;
 }
 
+sub evaluate_via_rpn  {
+  @s=();@o=();
+
+  for ( $_[0] =~ m{(-?\d+|[-+*()])}g ) {
+    if( m{\d} ) {
+      push @o, $_;
+    } elsif( $_ eq '(' ) {
+      push @s, $_;
+    } elsif( $_ eq ')' ) {
+      push @o, $_ while ($_ = pop @s) ne '(';
+    } else {
+      push @o, pop @s while @s && $f{$s[-1]}[0] && $f{$_}[0]<=$f{$s[-1]}[0];
+      push @s, $_;
+    }
+  }
+  push @o, reverse @s;
+
+  @s = ();
+  ## Now evaluate the RPN tree...
+    $_ eq '+' ? $s[-2] += pop @s
+  : $_ eq '-' ? $s[-2] -= pop @s
+  : $_ eq '*' ? $s[-2] *= pop @s
+  :             (push @s, $_) for @o;
+  $s[0];
+}
+
+## Code from hell... First for loop processes the infix into rpn
+##                   Second for loop processes the rpn stream
+sub evaluate_rpn_hsh  {
+  @o=(); @s=();
+  ($f{$_}) ? (&{$f{$_}[1]}) : (push@o,$_) for $_[0] =~ m{(-?\d+|[-+*()])}g;
+  ($f{$_}) ? (&{$f{$_}[2]}) : (push@s,$_) for @o, reverse splice @s,0;
+  $s[0];
+}
+