simple-math-parser.pl

#!/usr/bin/env perl
# simple-math-parser.pl - Simple math parser written in Perl 5
# License:  C.C. Attribution NonCommercial ShareAlike 3.0 Unported
# Revision: 120705

#---------------------------------------------------------------------
#                           important note
#---------------------------------------------------------------------

# This software is provided on an  AS IS basis with ABSOLUTELY NO WAR-
# RANTY.  The  entire risk as to the  quality and  performance of  the
# software is with you.  Should the software prove defective,  you as-
# sume the cost of all necessary  servicing, repair or correction.  In
# no event will any of the developers,  or any other party, be  liable
# to anyone for damages arising out of use of the software, or inabil-
# ity to use the software.

#---------------------------------------------------------------------
#                              overview
#---------------------------------------------------------------------

my $USAGE_TEXT = << 'END_OF_USAGE_TEXT';
Usage: simple-math-parser.pl "1.5+(2/3)*pi-sqrt(2)"

This  is a  CLI calculator program that takes a single  arithmetic ex-
pression as an argument, evaluates it, and prints the result to stand-
ard output.

As a general rule, expressions should be quoted as shown here.  Other-
wise, "shell meta-character" problems may occur.

The point of the program is to  illustrate the  structure of  a simple
math parser.  A recursive-descent approach is used;  the core consists
of a single recursive routine (ParseMath).

Numbers may be  integers,  ordinary real numbers,  or  real numbers in
scientific notation.  Examples of scientific notation: 1.3e+0 is equal
to 1.3, 12e-1 is equal to 1.2, and  5e+1 is equal to 50.  The "+" sign
is optional in this context.

Supported operators  include  + (add), - (subtract or unary minus),  *
(multiply), / (divide), and ** (exponentiate).

Six functions are supported: sqrt (square root), cbrt (cube root), log
(natural logarithm), sin, cos, and tan.  The last three functions take
angles in radians.

Three standard constants may be used:  e, phi (the Golden Ratio),  and
pi.

This is the first public release of the program.  Therefore, it should
be considered alpha and bugs may exist.
END_OF_USAGE_TEXT

#---------------------------------------------------------------------
#                        standard module setup
#---------------------------------------------------------------------

require 5.8.1;
use strict;
use Carp;
use warnings;
                                # Trap warnings
$SIG{__WARN__} = sub { die @_; };

#---------------------------------------------------------------------
#                           basic constants
#---------------------------------------------------------------------

use constant ZERO  => 0;        # Zero
use constant ONE   => 1;        # One
use constant TWO   => 2;        # Two

use constant FALSE => 0;        # Boolean FALSE
use constant TRUE  => 1;        # Boolean TRUE

#---------------------------------------------------------------------
#                        common math constants
#---------------------------------------------------------------------

# This table maps  one or more symbol names to associated numeric val-
# ues.

# Note:  Symbol names should  consist of a letter followed  by zero or
# more alphanumeric characters. Letters should be specified  in  lower
# case.

my %MathConstants =
(
    'e'   => '2.7182818284590452353603' ,
    'phi' => '1.6180339887498948482046' ,
    'pi'  => '3.1415926535897932384626'
);

#---------------------------------------------------------------------
#                         program parameters
#---------------------------------------------------------------------

#  $IE       = Internal-error message prefix
#  $MAXPRE   = Maximum precedence level
#  $PURPOSE  = Short description of purpose
#  $REVISION = Revision string
#  $USE_LESS = Flag: Use "less" for usage text

my $IE       = 'Internal error'                 ;
my $MAXPRE   = 9999                             ;
my $PURPOSE  = 'Simple Perl math parser'        ;
my $REVISION = '120705'                         ;
my $USE_LESS = TRUE                             ;

#---------------------------------------------------------------------
#                       token-related patterns
#---------------------------------------------------------------------

#  $PatNumScience = Matches a  non-negative number in scientific nota-
#                   tion
#  $PatNumRegular = Matches an ordinary non-negative number
#  $PatSymbol     = Matches a symbol
#  $PatOperator   = Matches a parenthesis or an operator

# Note:  In this context, exponentiation is represented by the single-
# character operator "~" as opposed to "**", which is used at a higher
# level. This simplifies the code.

my $PatNumScience = '\b\d+\.?\d*e[\+\-]?\d+'    ;
my $PatNumRegular = '\b\d+\.?\d*'               ;
my $PatSymbol     = '\b[a-z]\w+\b'              ;
my $PatOperator   = '[\(\)\+\-\*/~]'            ;

#---------------------------------------------------------------------

#  @TokenPatterns is a  list of all of  the patterns  that are used to
# match tokens.

my @TokenPatterns =
(                               # Note: Order is significant here
    $PatNumScience , $PatNumRegular , $PatSymbol , $PatOperator
);

#---------------------------------------------------------------------

#  $TokenPatterns is a pattern that matches a token  (of any supported
# type). The pattern omits enclosing parentheses.

my $TokenPatterns = join '|', @TokenPatterns;

#---------------------------------------------------------------------
#                       misc. global variables
#---------------------------------------------------------------------

my $PROGNAME;                   # Program name (without path)
   $PROGNAME =  $0;
   $PROGNAME =~ s@.*/@@;

#---------------------------------------------------------------------
#                          support routines
#---------------------------------------------------------------------

# Routine:  UsageError
# Purpose:  Prints program usage text and exits
# Usage:    &UsageError();

# If the global parameter $USE_LESS is TRUE, and if standard output is
# a terminal,  usage text is piped through  "less"  (with some "less"-
# related instructions added). Otherwise, usage text is simply sent to
# standard output.

#---------------------------------------------------------------------

sub UsageError
{
    $USAGE_TEXT =~ s@^\s+@@s;   # Remove leading white space

    $USAGE_TEXT = << "END";     # "END" must be double-quoted here
$PROGNAME $REVISION - $PURPOSE

$USAGE_TEXT
END
                                # Adjust trailing white space
    $USAGE_TEXT =~ s@\s*\z@\n@s;

    if ($USE_LESS && (-t STDOUT) && open (OFD, "|/usr/bin/less"))
    {                           # Handle output with "less"
                                # "END" must be double-quoted here
        $USAGE_TEXT = << "END";
To exit this "help" text, press "q" or "Q".  To scroll up or down, use
PGUP, PGDN, or the arrow keys.

$USAGE_TEXT
END
        print OFD $USAGE_TEXT;
        close OFD;
    }
    else
    {                           # Handle output without "less"
        print "\n", $USAGE_TEXT, "\n";
    }

    exit ONE;
}

#---------------------------------------------------------------------
#                           parser routine
#---------------------------------------------------------------------

# Routine:  ParseMath
# Purpose:  Parses a list of math-related tokens

# Usage:
#
#     my @tokens = ( '1', '+', '2', '/', '3' );
#     my $result = &ParseMath (\@tokens, 0);

# Note: "ParseMath" is recursive.

# This routine takes two arguments:  A reference (i.e., pointer)  to a
# list of tokens and an integer,  which should be zero unless the rou-
# tine happens to be calling itself  (in which case it may  use  other
# values internally).

# Tokens may be non-negative integer or real numbers,  plus  or  minus
# signs,  a  multiplication  or  division  or  exponentiation operator
# (*, /, or ~), parentheses, or the names  of  supported  functions or
# constants.

# Note: "~" is used at  this level instead of the more usual "**" as a
# matter of convenience. Higher-level code may map "**" or other char-
# acters or sequences to "~".

# Six functions are supported:  sqrt (square root),  cbrt (cube root),
# log (natural logarithm), sin, cos, and tan. The last three functions
# take angles in radians.

# Three  standard constants  may be used:  e,  phi (the Golden Ratio),
# and pi.

# Sub-expressions may be parenthesized.  PEMDAS (i.e., standard prece-
# dence) rules are supported.

# For numbers, scientific notation is supported.  Examples of scienti-
# fic notation:  1.3e+0 is equal to 1.3,  12e-1 is equal to  1.2,  and
# 5e+1 is equal to 50. The "+" sign is optional in this context.

# Minus signs,  as in the unary minus  operator,  must be specified as
# separate tokens.

#---------------------------------------------------------------------

sub ParseMath
{
                                # Argument list
    my ($p_tokens, $plevel) = @_;
    my $left;                   # Left  operand (or token)
    my $right;                  # Right operand
    my $result;                 # Result
    my $str;                    # Scratch

#---------------------------------------------------------------------
# Initial setup.

    $left = shift (@$p_tokens); # Get first token
                                # Consistency check
    die "$IE #0001\n" unless defined $left;

#---------------------------------------------------------------------
# Various cases.

# This block  handles  symbolic constants (such as pi),  parenthesized
# sub-expressions,  the  unary-minus operator,  and  functions such as
# "cos" or "sqrt".

    if (defined ($str = $MathConstants {$left}))
        { $left = $str;                                              }
    elsif ($left eq '(')
        { $left = &ParseMath ($p_tokens, ZERO );                     }
    elsif ($left eq '-')
        { $left = &ParseMath ($p_tokens, $MAXPRE); $left = (-$left); }
    elsif ($left =~ m@^(sqrt|cbrt|log|sin|cos|tan)\z@)
    {                           # Function
        $str  = $left;          # Name of function
                                # Function argument
        $left = &ParseMath ($p_tokens, TWO);

        eval
        {                       # "eval" traps most errors
            $left = sqrt ($left)                if $str eq 'sqrt'   ;
            $left = $left ** (1/3)              if $str eq 'cbrt'   ;
            $left = log ($left)                 if $str eq 'log'    ;
            $left = sin ($left)                 if $str eq 'sin'    ;
            $left = cos ($left)                 if $str eq 'cos'    ;
            $left = sin ($left) / cos ($left)   if $str eq 'tan'    ;
        };

        die $@ if $@;           # Handle trapped errors
    }

#---------------------------------------------------------------------
# Adjust and/or check intermediate result.

# This statement verifies that the current (left) operand has been re-
# duced to a number.

    die "Error: Invalid syntax\n"
        unless $left =~ m@^-?($PatNumScience|$PatNumRegular)\z@;

# This statement translates numbers that are still in scientific nota-
# tion to ordinary values (if possible).

    $left = $left + ZERO if $left =~ m@e@;

#---------------------------------------------------------------------
# Handle binary operators.

    while (TRUE)
    {
                                # Get operator token
        my $op = shift (@$p_tokens);
                                # Are we there yet?
        if (!defined ($op) || ($op eq ')')) { $result = $left; last; }
                                # Consistency check
        die "$IE #0002: $op\n" unless $op =~ m@[\+\-\*/~]\z@;

        my $nlevel = ZERO;      # Precedence level
           $nlevel = ONE if ($op eq '*') || ($op eq '/');
           $nlevel = TWO if ($op eq '~');

                                # Stop here due to precedence?
        if ($plevel && ($plevel >= $nlevel))
        {                       # Yes
            unshift (@$p_tokens, $op);
            $result = $left;
            last;
        }

        $plevel = $nlevel;      # Step to new precedence level
                                # Parse right side of sub-expression
        $right  = &ParseMath ($p_tokens, $plevel);

        eval
        {                       # Note: "eval" traps most errors
            $result = $left +  $right if $op eq '+';
            $result = $left -  $right if $op eq '-';
            $result = $left *  $right if $op eq '*';
            $result = $left /  $right if $op eq '/';
            $result = $left ** $right if $op eq '~';
        };

        die $@ if $@;           # Handle trapped errors
                                # Consistency check
        die "$IE #0003: $op\n" unless defined $result;

                                # Are we there yet?
        last unless scalar @$p_tokens;

        $plevel = ZERO;         # We've resolved the left operand
        $left   = $result;      # Result is left side of  another sub-
                                # expression
    }

#---------------------------------------------------------------------
# Wrap it up.

    $result;                    # Return the result
}

#---------------------------------------------------------------------
#                            main routine
#---------------------------------------------------------------------

sub Main
{
    my $data;                   # Input string
    my @tokens;                 # Input tokens

#---------------------------------------------------------------------
# Initial setup.

    select STDERR; $| = ONE;    # Force STDERR flush on write
    select STDOUT; $| = ONE;    # Force STDOUT flush on write

                                # Check the command line
    &UsageError() unless scalar (@ARGV) == ONE;

    $data   =  shift (@ARGV);   # Input string
    $data   =~ s@\s+@ @gs;      # Adjust white space
                                # Check characters used
    die "Invalid character in expression: $1\n"
        if $data =~ m@([^a-z0-9\.\(\)\+\-\*/~ ])@i;

#---------------------------------------------------------------------
# Perform operations.

    $data   =  lc ($data);      # Map input to lower case
    $data   =~ s@\*\*@~@g;      # Map "**" (exponentiation) to "~"
                                # (this simplifies the code)
                                # Put spaces around tokens
    $data   =~ s@($TokenPatterns)@ $1 @gi;
                                # Split data into a tokens list
    @tokens =  split m@\s+@, $data;
                                # Discard empty strings
    @tokens =  grep { length; } @tokens;
                                # Parse tokens and print result
    print &ParseMath (\@tokens, ZERO), "\n";
    undef;
}

#---------------------------------------------------------------------
#                            main program
#---------------------------------------------------------------------

&Main();                        # Call the main routine
exit ZERO;                      # Normal exit