Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^4: Generic RPN Translator available?

by BrowserUk (Patriarch)
on Jan 21, 2005 at 06:15 UTC ( [id://423889]=note: print w/replies, xml ) Need Help??


in reply to Re^3: Generic RPN Translator available?
in thread Generic RPN Translator available?

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?

#! 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_num | $re_func | $re_subex | $re_var ]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 $varargs = 0; { my( $left, $op, $right, $rest ) = $exp =~ m[ ^ (?: ( $re_term )? ( $re_op ) )? ( $re_term ) ( .* ) $ ]x or die "malformed (sub)expression '$exp'"; $varargs++ if $op and $op eq ','; 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, ++$varargs if $op and $op eq ',' and not $rest; 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; while( <DATA> ) { chomp; printf "%s \n\t %s\n\n", $_, join', ', parseExp $_; } __END__ 1+2+3 a+b+c abc+def+Efg_hij 2.0+1e-2/0.01E-21 max( a, b, c, d ) * atan( pi*4, -1 ) sin( cos( x ) - tan( y ) ) + f( g( z ) ) 2*(somevar+other) + max(this, that) A+(B*C-D)/E (a*(b)-c^(3.4e-2)) 5^((-2e-3+x)*sin(p+4.0)/fred) sin(a) + sin(ab) + sin( a, b ) Func_1( 1, Func_2( Func3( 1* 2 * 3) * aFunc( 3 ) )+FuNc(4,5,6), -2,e, +-10, -2e-10 ) +1

Examine what is said, not who speaks.
Silence betokens consent.
Love the truth but pardon error.

Replies are listed 'Best First'.
Re^5: Generic RPN Translator available?
by BrowserUk (Patriarch) on Jan 21, 2005 at 08:50 UTC

    An updated version of the above with all the bugs I am aware of fixed.

    It attempts to verify the results by reversing them. The caveat being that as far as I can see, there is no easy way to put back parenthesis around subexpressions? Hence it will flag expressions that contain parenthesised subexpression as not being correctly.

    In every case I have tested, the expression has been reversed correctly except for the replacement of the parens.

    It's not a perfect test method, but the best I have come up with. Anyone have a better one?

    Results

    Code:


    Examine what is said, not who speaks.
    Silence betokens consent.
    Love the truth but pardon error.
      Hmm, looks like precedence of * and / over + and - isn't handled correctly:
      a+b*c/2
      should yield
      a,b,c,*,2,/,+
      but results in
      a,b,+,c,*,2,/
      instead. I guess we really need grammar, especially if you into consideration that an operator like '**' or '^' needs even higher precedence.

        Update: It took all of about 25 minutes to implement 4 levels of presedence:

        ** | */% | +- | ,func()

        P:\test>423305 1+2*3 2, 3, *, 1, + ((2*3)+1) 1+2*3**4 3, 4, **, 2, *, 1, + (((3**4)*2)+1)

        It's not complete, but I thought you were looking for a starting point--not finished code.

        Have fun!


        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://423889]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (8)
As of 2024-05-21 10:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found