File Coverage

blib/lib/Math/Calculator.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	12	12	100.0
condition	3	3	100.0
subroutine	35	35	100.0
pod	22	22	100.0
total	123	123	100.0

use strict;
use warnings;
package Math::Calculator 1.023;
# ABSTRACT: a multi-stack calculator class

#pod =head1 SYNOPSIS
#pod
#pod  use Math::Calculator;
#pod
#pod  my $calc = Math::Calculator->new;
#pod
#pod  $calc->push(10, 20, 30);
#pod  $calc->add;
#pod  $calc->root; # 1.0471285480509  (50th root of 10)
#pod
#pod =head1 DESCRIPTION
#pod
#pod Math::Calculator is a simple class representing a stack-based calculator.  It
#pod can have an arbitrary number of stacks.
#pod
#pod =method new
#pod
#pod This class method returns a new Math::Calculator object with one stack
#pod ("default").
#pod
#pod =cut

sub new {
	bless {
		stacks => { default => [] },
		current_stack => 'default'
	} => shift
}

#pod =method current_stack
#pod
#pod   $calc->current_stack($stackname)
#pod
#pod This method sets the current stack to the named stack.  If no stack by the
#pod given name exists, one is created and begins life empty.  Stack names are
#pod strings of word characters.  If no stack name is given, or if the name is
#pod invalid, the stack selection is not changed.
#pod
#pod The name of the selected stack is returned.
#pod
#pod =cut

sub current_stack {
	my ($self, $stack) = @_;

	return $self->{current_stack} unless $stack and $stack =~ /^\w+$/;
	$self->{stacks}{$stack} = [] unless defined $self->{stacks}{$stack};
	$self->{current_stack} = $stack;
}

#pod =method stack
#pod
#pod   $calc->stack($stackname)
#pod
#pod This method returns a (array) reference to the stack named, or the current
#pod selected stack, if none is named.
#pod
#pod =cut

sub stack { $_[0]->{stacks}->{$_[1] ? $_[1] : $_[0]->current_stack} }

#pod =method top
#pod
#pod   $calc->top
#pod
#pod This method returns the value of the top element on the current stack without
#pod altering the stack's contents.
#pod
#pod =cut

sub top   { (shift)->stack->[-1] }

#pod =method clear
#pod
#pod   $calc->clear
#pod
#pod This clears the current stack, setting it to C<()>.
#pod
#pod =cut

sub clear { @{(shift)->stack} = (); }

#pod =method push
#pod
#pod   $calc->push(@elements);
#pod
#pod C pushes the given elements onto the stack in the order given.
#pod
#pod =method push_to
#pod
#pod   $calc->push_to($stackname, @elements)
#pod
#pod C is identical to C, but pushes onto the named stack.
#pod
#pod =cut

sub push { ## no critic
  push @{(shift)->stack}, @_;
}
sub push_to { CORE::push @{(shift)->stack(shift)}, @_; }

#pod =method pop
#pod
#pod   $calc->pop($howmany)
#pod
#pod This method pops C<$howmany> elements off the current stack, or one element, if
#pod C<$howmany> is not defined.
#pod
#pod =method pop_from
#pod
#pod   $calc->pop_from($stack, $howmany);
#pod
#pod C is identical to C, but pops from the named stack.  C<$howmany>
#pod defaults to 1.
#pod
#pod =cut

sub pop { ## no critic
  splice @{$_[0]->stack}, - (defined $_[1] ? $_[1] : 1);
}
sub pop_from { splice @{$_[0]->stack($_[1])}, - (defined $_[2] ? $_[2] : 1); }

#pod =method from_to
#pod
#pod   $calc->from_to($from_stack, $to_stack, [ $howmany ])
#pod
#pod This pops a value from one stack and pushes it to another.
#pod
#pod =cut

sub from_to { $_[0]->push_to($_[2], $_[0]->pop_from($_[1], $_[3])) }

#pod =method dupe
#pod
#pod   $calc->dupe;
#pod
#pod C duplicates the top value on the current stack.  It's identical to C<<
#pod $calc->push($calc->top) >>.
#pod
#pod =cut

sub dupe { $_[0]->push( $_[0]->top ); }

#pod =method _op_two
#pod
#pod   $calc->_op_two($coderef)
#pod
#pod This method, which is only semi-private because it may be slightly refactored
#pod or renamed in the future (possibly to operate on I elements), pops two
#pod elements, feeds them as parameters to the given coderef, and pushes the result.
#pod
#pod =cut

# sub _op_two { $_[0]->push( $_[1]->( $_[0]->pop(2) ) ); $_[0]->top; }

sub _op_two { ($_[0]->_op_n(2, $_[1]))[-1] }
sub _op_n {
	$_[0]->push(my @r = $_[2]->( $_[0]->pop($_[1]) ));
	wantarray ? @r : $r[-1]
}

#pod =method twiddle
#pod
#pod This reverses the position of the top two elements on the current stack.
#pod
#pod =cut

sub twiddle  { (shift)->_op_two( sub { $_[1], $_[0] } ); }

#pod =method add
#pod
#pod  x = pop; y = pop;
#pod  push x + y;
#pod
#pod This pops the top two values from the current stack, adds them, and pushes the
#pod result.
#pod
#pod =method subtract
#pod
#pod  x = pop; y = pop;
#pod  push x - y;
#pod
#pod This pops the top two values from the current stack, subtracts the second from
#pod the first, and pushes the result.
#pod
#pod =method multiply
#pod
#pod  x = pop; y = pop;
#pod  push x * y;
#pod
#pod This pops the top two values from the current stack, multiplies them, and
#pod pushes the result.
#pod
#pod =method divide
#pod
#pod  x = pop; y = pop;
#pod  push x / y;
#pod
#pod This pops the top two values from the current stack, divides the first by the
#pod second, and pushes the result.
#pod
#pod =cut

sub add      { (shift)->_op_two( sub { (shift) + (shift) } ); }
sub subtract { (shift)->_op_two( sub { (shift) - (shift) } ); }
sub multiply { (shift)->_op_two( sub { (shift) * (shift) } ); }
sub divide   { (shift)->_op_two( sub { (shift) / (shift) } ); }

#pod =method modulo
#pod
#pod  x = pop; y = pop;
#pod  push x % y;
#pod
#pod This pops the top two values from the current stack, computes the first modulo
#pod the second, and pushes the result.
#pod
#pod =method raise_to
#pod
#pod  x = pop; y = pop;
#pod  push x ** y;
#pod
#pod This pops the top two values from the current stack, raises the first to the
#pod power of the second, and pushes the result.
#pod
#pod =method root
#pod
#pod  x = pop; y = pop;
#pod  push x ** (1/y);
#pod
#pod This pops the top two values from the current stack, finds the Ith root of
#pod I, and pushes the result.
#pod
#pod =method sqrt
#pod
#pod This method pops the top value from the current stack and pushes its square
#pod root.
#pod
#pod =cut

## no critic Subroutines::ProhibitBuiltinHomonyms
sub modulo   { (shift)->_op_two( sub { (shift) % (shift) } ); }
sub sqrt     { my ($self) = @_; $self->push(2); $self->root; }
## use critic
sub raise_to { (shift)->_op_two( sub { (shift) **(shift) } ); }
sub root     { (shift)->_op_two( sub { (shift)**(1/(shift)) } ); }

#pod =method quorem
#pod
#pod =method divmod
#pod
#pod This method pops two values from the stack and divides them.  It pushes the
#pod integer part of the quotient, and then the remainder.
#pod
#pod =cut

sub _quorem  { my ($n,$m) = @_; (int($n/$m), $n % $m) }
sub quorem   { (shift)->_op_n(2, \&_quorem ); }
sub divmod   { (shift)->_op_n(2, \&_quorem ); }

#pod =head1 TODO
#pod
#pod I'd like to write some user interfaces to this module, probably by porting
#pod Math::RPN, writing a dc-alike, and possibly a simple Curses::UI interface.
#pod
#pod I want to add BigInt and BigFloat support for better precision.
#pod
#pod I'd like to make Math::Calculator pluggable, so that extra operations can be
#pod added easily.
#pod
#pod =head1 SEE ALSO
#pod
#pod =for :list
#pod * L
#pod * L
#pod
#pod =head1 THANKS
#pod
#pod Thanks, also, to Duan TOH.  I spent a few days giving him a crash course in
#pod intermediate Perl and became interested in writing this class when I used it as
#pod a simple example of how objects in Perl work.
#pod
#pod =cut

1;

__END__