Acme-AlgebraicToRPN

 view release on metacpan or  search on metacpan

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

  userFunc - user functions, as array reference

If you had a user function box and fft, you'd need to
specify them like this:

  $al = Acme::AlgebraicToRPN->new(userFunc =>
    [qw(box fft)]);

=cut

sub new {
    my ($class, %opts) = @_;
    my $self = \%opts;
    bless $self, $class;
    $.stack = [];
    $.parser = Math::Symbolic::Parser->new;
    $.Class = $class;
    if (defined $.userFunc) {
        my @uf = @{$.userFunc};
        my %uf;
        map { $uf{$_} = 1 } @uf;
        $.userFunc = \%uf;
        my %x;
        map {
            my $proc = $_;
            $x{$_} = sub {
                my $argumentstring = shift;
                return Math::Symbolic::Constant->new(
                    qq($proc($argumentstring))
                );
            };
        } @uf;
        Math::SymbolicX::ParserExtensionFactory->add_private_functions(
            $.parser,
            %x
        );

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

      the next thing on the stack is the I<number> of arguments,
      and then the arguments themselves. For example, let's say
      you registered your function 'foo' (in constructor)
      and you gave B<rpn> this equation: 4*foo(a,3)

      You'd get back this:
      4 a 3 2 foo multiply

=cut

sub rpn {
    my ($self, $algebraic) = @_;
    $algebraic =~ s/\s+//g;
    # ensure parens match
    my $open  = $algebraic =~ tr/(/(/;
    my $close = $algebraic =~ tr/)/)/;
    return unless $open == $close;
    #my $tree = Math::Symbolic->parse_from_string($algebraic);
    my $tree;
    my $rpn;

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

=head2 B<rpn_as_string>

  $stack = $al->rpn($expr);

Same as B<rpn>, but returns as a comma-separated list. Split on
commas, and you have your stack to be processed.

=cut

sub rpn_as_string {
    my ($self, $algebraic) = @_;
    my @result = ./rpn($algebraic);
    return join(",", @result);
}

sub _Cleanup {
    my ($self) = @_;
    my @Stack;
    map {
        $_ =~ s/^,//;
        if ($_ ne '') {
            my (@c) = split(',', $_);
            if (@c) {
                s/\s//g foreach @c;
                push(@Stack, @c);
            }
            else {
                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);
        }

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

  $ok = $al->check(\@stack, @expected);

Checks result of RPN conversion. @stack is what the B<rpn> function
returned, and @expected is what you expected the result to be. This
is kind of a diagnostic routine for testing.

Returns 1 if both @stack and @expected were the same, 0 if not.

=cut

sub check {
    my ($self, $ref, @result) = @_;
    my @shouldbe = @$ref;
    return 0 unless @shouldbe == @result;
    my $same = 1;
    map {
        my $sb = shift(@shouldbe);
        $same = 0 unless $sb eq $_;
    } @result;
    return $same;
}

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

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);