Mathematical expressions in the traditional algebraic notation can be calculated using an algorithm RPN (Reverse Polish Notation). In the first part of this article, I will show you how to implement a parser that converts the traditional algebraic form of mathematical expression to the RPN notation. In the second part of article, I will implement an algorithm for calculating the RPN expression and the architecture which allows for easy extend the the parser to support mathematical custom functions.

Infix and postfix notation

In the infix notation, order of the algebraic operations can be changed using brackets. In this notation, the operator is placed between operands. In the postfix notation, the operator is placed after the operand. So in this form, the use of brackets can be omitted, because the order of operations depends on the priority of operators.

Conversion to the RPN notation

The shunting-yeard algorithm is a method for conversion a mathematical expression to the RPN notation. The presented algorithm uses stack for accumulating operators and queue for functions and operands. In contrast to the algorithm described on the Wikipedia, this algorithm supports situation for the unary plus/minus.

Shunting-yard algorithm (iterative)

Implementation of the conversion class for RPN

We will write a class for conversion a mathematical expression to the RPN representation. The stack and queue will be used as a data structure. In the following listing, we will use a generic collection which are available since Delphi XE. For the older version, you can use TStack and TQueue classes from the Contnrs module and manually cast pointers to the appropriate type.

Declaration of the TParser class

unit ONPParser;
interface
uses
  Generics.Collections, SysUtils;
type
  TParser = class
    const
      PRIORITY_ADD = Byte(1);
      PRIORITY_MULTI = Byte(2);
      PRIORITY_POWER = Byte(3);
      PRIORITY_FUNC = Byte(4);
    private
     FStack: TStack<TMathObject>;
      FQueue: TQueue<TMathObject>;
      FExpression: string;
      FResult: Double;
      FPriorityRules: TDictionary<Char, Byte>;
      procedure EraseCntr(Sender: TObject; const Item: TMathObject; Action: TCollectionNotification);
      procedure InfixToPostfix;
      procedure Calc;
      procedure Clear;
    public
      constructor Create;
      destructor Destroy; override;
      procedure Calculate(const Expression: string);
      function GetResult: Double;
end;

Declaration of the TMathObject class

This class will be responsible for handling tokens and a conversion between types.

type
  TMathObject = class;
  TMathObjectType = (mtUndefined, mtString, mtFloat);
  TMathArgs = Generics.Collections.TList<TMathObject>;
  TMathObject = class
    private
      FData: Variant;
      FType: TMathObjectType;
      FPriority: Byte;
    public
      function ToFloat: Double;
      function ToInt: Integer;
      function ToString: string; override;
      function ToChar: Char;
      function GetPriority(): Byte; inline;
      function IsFunction(): Boolean; inline;
      constructor Create(const Data: Double); overload;
      constructor Create(const Data: string); overload;
      constructor Create(const Data: string; Priority: Byte); overload;
end;

Implementation of the TMathObject

constructor TMathObject.Create(const Data: string);
begin
  FData := Data;
  FType := mtUndefined;
end;
constructor TMathObject.Create(const Data: Double);
begin
  FData := Data;
  FType := mtFloat;
end;
constructor TMathObject.Create(const Data: string; Priority: Byte);
begin
  FData := Data;
  FType := mtString;
  FPriority := Priority;
end;
function TMathObject.ToFloat: Double;
begin
  if FType <> TMathObjectType.mtFloat then
    Result := StrToFloat(FData, Fmt)
  else
    Result := Double(FData);
end;
function TMathObject.ToInt: Integer;
begin
  if FType<> TMathObjectType.mtFloat then
    Result := StrToInt(FData)
  else
    Result := Trunc(FData);
end;
function TMathObject.ToString: string;
begin
  if FType = TMathObjectType.mtFloat then
    Result := FloatToStr(FData, Fmt)
  else
    Result := FData;
end;
function TMathObject.ToChar: Char;
begin
  Result := ToString[1];
end;
function TMathObject.GetPriority(): Byte;
begin
  Result := FPriority;
end;
function TMathObject.IsFunction(): Boolean;
begin
  Result := FType = mtString;
end;

With that implementation of the TMathObject, We can complete the implementation of the TParser class.

Constructor / destructor

constructor TParser.Create;
begin
  FResult := NaN;
  FStack := TStack<TMathObject>.Create();
  FQueue := TQueue<TMathObject>.Create();
  FStack.OnNotify := EraseCntr;
  FQueue.OnNotify := EraseCntr;
  FPriorityRules := TDictionary<Char, Byte>.Create(5);
  FPriorityRules.Add('+', PRIORITY_ADD);
  FPriorityRules.Add('-', PRIORITY_ADD);
  FPriorityRules.Add('*', PRIORITY_MULTI);
  FPriorityRules.Add('/', PRIORITY_MULTI);
  FPriorityRules.Add('^', PRIORITY_POWER);
end;

destructor TParser.Destroy;
begin
  Clear;
  FPriorityRules.Free;
  FQueue.Free;
  FStack.Free;
end;

Rest implementation

procedure TParser.EraseCntr(Sender: TObject; const Item: TMathObject; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Item.Free;
end;
function TParser.GetResult;
begin
  Result := FResult;
end;
procedure TParser.Calculate(const Expression: string);
begin
  FExpression := Expression;
  Clear;
  InfixToPostfix;
  Calc;
end;
procedure TParser.Clear;
begin
  FStack.Clear;
  FQueue.Clear;
end;

Implementation of the parse function

procedure TParser.InfixToPostfix;
const
  Brackets = ['(', ')'];
  OperatorSet = ['+', '-', '*', '/', '^'];
  NumberSet = ['0' .. '9', '.'];
  FunctionSet = ['A' .. 'Z'];
  UnarySet = ['+', '-'];
  ArgsSeparator = ';';
var
  I, Ind: Integer;
  Len: Integer;
  MathObject: TMathObject;
  Unary: Boolean;
  Priorit: Byte;
begin
  I := 1;
  Len := Length(FExpression);
  Unary := True;
  while I <= Len do
  begin
    if CharInSet(FExpression[I], NumberSet) then
    begin
      Unary := False;
      Ind := I;
      while (I <= Len) and CharInSet(FExpression[I], NumberSet) do
        Inc(I);
      MathObject := TMathObject.Create(Copy(FExpression, Ind, I - Ind));
      FQueue.Enqueue(MathObject);
    end
    else if CharInSet(FExpression[I], FunctionSet) then
    begin
      Ind := I;
      while (I <= Len) and CharInSet(FExpression[I], FunctionSet) do
        Inc(I);
      MathObject := TMathObject.Create(Copy(FExpression, Ind, I - Ind),
                      PRIORITY_FUNC);
      FStack.Push(MathObject);
    end
    else if Unary and CharInSet(FExpression[I], UnarySet) then
    begin
      if FExpression[I] = '-' then
      begin
        MathObject := TMathObject.Create('NEG', PRIORITY_FUNC);
        FStack.Push(MathObject);
      end;
      Inc(I);
    end
    else if FExpression[I] = ArgsSeparator then
    begin
      while (FStack.Count > 0) and (FStack.Peek.ToString() <> '(') do
        FQueue.Enqueue(FStack.Extract);
      if FStack.Count = 0 then
        raise EParserError.Create('Left bracket not found');
      Inc(I);
      Unary := True;
    end
    else if FExpression[I] = '(' then
    begin
      MathObject := TMathObject.Create('(');
      FStack.Push(MathObject);
      Inc(I);
      Unary := True;
    end
    else if FExpression[I] = ')' then
    begin
      while (FStack.Count > 0) and (FStack.Peek.ToString() <> '(') do
        FQueue.Enqueue(FStack.Extract);
      if FStack.Count = 0 then
        raise EParserError.Create('Left bracket not found');
      FStack.Extract.Free;
      Inc(I);
      Unary := False;
    end
    else if CharInSet(FExpression[I], OperatorSet) then
    begin
      Priorit := FPriorityRules.Items[FExpression[I]];
      while (FStack.Count <> 0) and (Priorit <= FStack.Peek.GetPriority()) do
        FQueue.Enqueue(FStack.Extract);
      MathObject := TMathObject.Create(FExpression[I], Priorit);
      FStack.Push(MathObject);
      Inc(I);
      Unary := True;
    end
  end;
while FStack.Count <> 0 do
  begin
    if CharInSet(FStack.Peek.ToChar, Brackets) then
      raise EParserError.Create('Incorrect brackets');
    FQueue.Enqueue(FStack.Extract);
  end;
end;

Usage

If you want to use my parser code or need help to fit it to your requirements, you can contact with me.

Summary

In the first part of the article, the implementation of the Shunting-yard algorithm was presented. This algorithm is used to the conversion of the standard infix notation to produce output for the RPN algorithm to calculate value of mathematical expression. In the next part, I will implement the RPN algorithm and architecture for easy extend the parser for support custom mathematical functions, without modifiication an existing code.

---

---

Related posts