view release on metacpan or  search on metacpan

lib/Acme/AlgebraicToRPN.pm  view on Meta::CPAN

    #my $tree = Math::Symbolic->parse_from_string($algebraic);
    my $tree;
    my $rpn;

    eval q(
        $tree = $.parser->parse($algebraic);
        $rpn  = $tree->to_string('prefix');
    );

    if ($@) {
        print STDERR "$.Class - equation didn't parse; did you forget ",
            "to add a userFunc?\n";
        return undef;
    }

    $rpn =~ s/\s//g;
    ./_Eval($rpn);
    my @result = ./_Cleanup();
    # reset, ready for next equation
    $.stack = [];
    return @result;

lib/Acme/AlgebraicToRPN.pm  view on Meta::CPAN

                push(@Stack, $_);
            }
        }
    } @{$.stack};
    return @Stack;
}

sub _Eval {
    my ($self, $expr) = @_;
    return unless defined $expr;
    #print "Evaling $expr\n";
    if ($expr =~ /(.+?),(.+)/) {
        my $L = $1;
        my $R = $2;
        if ($L =~ /^\w+$/ && $R =~ /$RE{balanced}{-parens=>'()'}/) {
            #print "HERE $L\n";
            push(@{$.stack}, $L);
        }
    }

    if ($expr =~ /(\w+)($RE{balanced}{-parens=>'()'})(.*)/) {
        my $op = $1;
        my $p  = $2;
        my $r  = $3;
        my $core = substr($p, 1, length($p)-2);
        if (defined $.userFunc && defined $.userFunc{$op}) {

t/01-test.t  view on Meta::CPAN

$expr = '2*news(a)/2+pi';
test('-sin(box(a,20))', qw(a 20 2 box sin negate));
test('log(a)', qw(a log));
test('atan2(a,b)', qw(a b atan2));
test('a^b', qw(a b exponentiate));
test('a^b3', qw(a b3 exponentiate));
test('a^-1', qw(a 1 negate exponentiate));
test('sin(pi/3)*2/log(2,1.3)', qw(pi 3 divide sin 2 multiply 2 1.3 log divide));
test('4*foo(a,3)', qw(4 a 3 2 foo multiply));
test('4*foo(a,3,55)', qw(4 a 3 55 3 foo multiply));
print STDERR "Shouldn't parse due to 'boo' function, which we don't know\n";
ok(!defined($rpn->rpn('4*boo(a,3,55)')));
#print $rpn->rpn_as_string($expr), "\n";

sub test {
    my ($expr, @desired) = @_;
    print STDERR "rpn = $expr... ";
    my @r = $rpn->rpn($expr);
    #print Dumper(\@r);
    my $same = $rpn->check(\@desired, @r);
    print STDERR "Different lengths\n" unless @r == @desired;
    print STDERR $same ? "Ok!\n" : "NOT Ok!\n";
    print STDERR "Got: ", Dumper(\@r) unless $same;
    print STDERR "Expected: ", Dumper(\@desired) unless $same;
    ok($same);
}