Subversion Repositories socgen

#!/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