view release on metacpan or  search on metacpan

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

package Acme::AlgebraicToRPN;

use warnings;
use strict;

our $VERSION = '0.02';

=head1 NAME

Acme::AlgebraicToRPN - convert algebraic notation to sane RPN

=head1 VERSION

Version 0.02

=head1 SYNOPSIS

  $rpn = Acme::AlgebraicToRPN->new;
  @RPN = $rpn->eval($equation);

=head1 DESCRIPTION

Given a string with algebraic notation, convert to RPN, which is
what any crappy dime store calculator needs to do anyway.

Doesn't really process anything, that's up to you. You will get an
array back with all of the variables and operations in RPN format.
So that 3+4 will come back as

    3
    4
    add

Possible future extensions will be to allow you to actually process
this via hooks that allow specifications of how to handle foreign
functions. But for my purposes, the array is good enough, as I am
passing this on to a C program to do some serious number crunching.

Additionally, you can specify (via the constructor) the names of
your own functions. See below.

=head1 ACKNOWLEDGEMENT

The Hewlett Packard Company and the HP 35, my first real calculator,
and Steffen Mueller for the Math::Symbolic code.

=head1 AUTHOR

X Cramps, C<< <cramps.the at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-acme-algebraictorpn at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Acme-AlgebraicToRPN>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Acme::AlgebraicToRPN

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Acme-AlgebraicToRPN>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Acme-AlgebraicToRPN>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Acme-AlgebraicToRPN>

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

    return $self;
}

=head2 B<rpn>

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

Processes $expr (an algebraic format expression) and return the
stack necessary to process it. The stack consists entirely of
variables, constants and operations. For operations, be
prepared to handle (and others, see B<Math::Symbolic> documentation):

  negate
  add
  subtract
  multiply
  divide
  exponentiate
  sin
  cos
  tan
  cot
  asin
  acos
  atan
  atan2
  acot
  sinh
  cosh
  asinh
  acosh

Plus any that you may add in constructor [1].

undef is returned if the parens don't balance. That's all the
checking we do.

  [1] If you supply a custom function, you can supply arguments
      to it. When you see your function name on the returned stack,
      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;

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

=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=>'()'}/) {