Re: Generic RPN Translator available?

[BrowserUk]

This might form a useful starting point. It seems reasonably accurate, flexible and efficient.

Update: Improved error handling a little and added -XLATE option.

Update2: Apparently there is something wrong with this code. Would someone care to tell me what that is?

#! perl -slw
use strict;
use List::Util qw[ reduce ]; $a=$b;

our $XLATE ||= 0;

sub nestedOk{ 
    index( $_[ 0 ], '(' ) <= index( $_[ 0 ], ')' ) and
    0 == reduce{
        $a + ( $b eq '(' ) - ( $b eq ')' ) 
    } 0, split'[^()]*', $_[ 0 ] 
}

my $re_var   = qr[ [a-zA-Z]\w* ]x;
my $re_subex = qr[ \{\d+\} ]x;
my $re_func  = qr[ $re_var $re_subex ]x;
my $re_num   = qr[ -? \d+ (?: \. \d+ )? (?: [Ee] [+-]? \d+ )? ]x;
my $re_term  = qr[ $re_func | $re_subex | $re_var | $re_num ]x;
my $re_op    = qr[[,%+*/^-]];
my %ops = ( qw[ % MOD + ADD * MULT / DIV ^ POW - SUBT ] );

sub exp2rpn {
    my( $exp, $aStack, $aBits ) = @_;
    die "Unbalanced parens: '$exp'" unless nestedOk $exp;
    {
        my( $left, $op, $right, $rest ) = $exp =~ m[
            ^ ( $re_term )? ( $re_op )? ( $re_term ) ( .* ) $
        ]x or die "malformed (sub)expression '$exp'";
        
        for ( $left, $right ) {
            next unless $_;
            if( my( $func, $subex ) = m[^ ( $re_var )? \{ ( \d+ ) \} $
+]x ) {
                exp2rpn( $aBits->[ $subex ], $aStack, $aBits ); 
                push @$aStack, $func if $func 
            }
            else{
                push( @$aStack, $_  );
            }
        }
        push @$aStack, $XLATE ? $ops{ $op } : $op
            if $op and $op ne ',';
        $exp = $rest, redo if $rest;
    }    
    return $aStack;
}

sub parseExp {
    local $_ = $_[ 0 ];
    s[\s+][]g;
    my( $bit, @bits ) = 0;
    s[\( ( [^()]+ )  \)]{ push @bits, $1; "{${ \( $bit++ ) }}"; }ex 
          while m[[()]];
    my $toplvl = $_;
    return @{ exp2rpn $toplvl, [], \@bits };
}

die "No expression given\n" unless @ARGV;
print join', ',  parseExp $ARGV[ 0 ];

__END__
P:\test>423305-2 "2*(somevar+other) + max(this, that)"
2, somevar, other, +, *, this, that, max, +

P:\test>423305-2 "5^((-2+x)*sin(p+4)/fred)"
5, -2, x, +, p, 4, +, sin, *, fred, /, ^

P:\test>423305-2 "A+(B*C-D)/E"
A, B, C, *, D, -, +, E, /

P:\test>423305-2 "max( a, b, c, d ) * atan( pi*4, -1 )"
a, b, c, d, max, pi, 4, *, -1, atan, *

P:\test>423305 -XLATE "5^((-2+x)*sin(p+4)/fred)"
5, -2, x, ADD, p, 4, ADD, sin, MULT, fred, DIV, POW

You may need to tweak the named regex at the top to match your definition of variable names, function names and acceptable numeric forms.

Functions are assumed to have fixed numbers of arguments and know how to unstack the correct number. I don't know how (or if) functions with variable numbers of arguments are handle in RPN?

[dfaure]

I don't know how (or if) functions with variable numbers of arguments are handle in RPN?

As a previous life's HP-48 owner, number of arguments is pushed onto the stack after them. Since functions know how to unstack their args, in this case this is a two steps operation

[saintmike]

Update: Looks like I spoke too soon:

"sin(ab)"

yields

sin, a, b

instead of the correct

sin, ab

Hmmm ...

Actually, I was looking for exactly the solution browserUK provided. Outstanding job, browserUK! It even works for nested function calls like


"max(min(a,b-c), c, min(d-f,e) ) * atan( pi*4, -1 )"

which gets transformed to


a, b, c, -, min, c, d, f, -, e, min, max, pi, 4, *, -1, atan, *

Now, anyone up for a Parse::Descent grammar, just for kicks :) ?

[BrowserUk]

Fixed. Update: But it still has another bug!..

P:\test>423305 -XLATE
1+2+3
         1, 2, ADD, 3, ADD

a+b+c
         a, b, ADD, c, ADD

abc+def+Efg_hij
         abc, def, ADD, Efg_hij, ADD

2.0+1e-2/0.01E-21
         2.0, 1e-2, ADD, 0.01E-21, DIV

max( a, b, c, d ) * atan( pi*4, -1 )
         a, b, c, d, 4, max, pi, 4, MULT, -1, 2, atan, MULT

sin( cos( x ) - tan( y ) ) + f( g( z ) )
         x, cos, y, tan, SUBT, sin, z, g, f, ADD

2*(somevar+other) + max(this, that)
         2, somevar, other, ADD, MULT, this, that, 2, max, ADD

A+(B*C-D)/E
         A, B, C, MULT, D, SUBT, ADD, E, DIV

(a*(b)-c^(3.4e-2))
         a, b, MULT, c, SUBT, 3.4e-2, POW

5^((-2e-3+x)*sin(p+4.0)/fred)
         5, -2e-3, x, ADD, p, 4.0, ADD, sin, MULT, fred, DIV, POW

sin(a) + sin(ab) + sin( a, b )
         a, sin, ab, sin, ADD, a, b, 2, sin, ADD

Func_1( 1, Func_2( Func3( 1* 2 * 3) * aFunc( 3 ) )+FuNc(4,5,6), -2,e, 
+-10, -2e-10 ) +1
         1, 1, 2, MULT, 3, MULT, Func3, 3, aFunc, MULT, Func_2, 4, 5, 
+6, 3, FuNc, ADD, -2, e, -10, -2e-10, 6, Func_1, 1, ADD

Anyone have a ready source of expressions plus their RPN forms? Or a clever way of verifying them?

Read more... (3 kB)

[BrowserUk]

It had to be either that, or a sentinel. So, the following expression => RPN would be correct?

P:\test>423305 "max( a, b, c, d ) * atan( pi*4, -1 )"
a, b, c, d, 4, max, pi, 4, *, -1, 2, atan, *

Modified code

Read more... (2 kB)

[dfaure]

Seems OK.

On a real HP, the max function handles only 2 parameters, but your max definition could be emulated with a loop and the number of parameters to manage is required.