unit Calculator;

(*
  Small library for parsing and calculating algebraic expressions.
  Author: Ivan Sagalaev (Maniac@SoftwareManiacs.Org).

  Feel free to contact my on any issues, suggestions, bugs etc.
*)

interface

Uses SysUtils;

Type
  ECalc=Class(Exception);

  ICalculator=Interface
    procedure SetVariable(const AName: String; const Value: Double);
    procedure TrySetVariable(const AName: String; const Value: Double);
    Function Calc:Double;
  End;{ICalculator}

Function CreateCalculator(Const Expression:String):ICalculator;
Function CreateCalculatorLocale(Const Expression:String):ICalculator;

implementation

Uses Contnrs, Classes, Math;

Type
  TDoublesStack=Class(TStack)
  Private
    FormatSettings:TFormatSettings;
  Public
    Constructor Create(AFormatSettings:TFormatSettings);
    Destructor Destroy;Override;
    Function Pop:Double;
    Function Push(ADouble:Double):Double;
    Function PushString(ADouble:String):Double;
  End;{TDoublesStack}

  TCalculator=Class(TInterfacedObject,ICalculator)
  Private
    FExpression:String;
    FTokens:TStringList;
    Operators:TStringList;
    Results:TDoublesStack;
    FormatSettings:TFormatSettings;
    Procedure Parse(Const Expression:String);
    Function LowerPrecedence(Const Operator1,Operator2:String):Boolean;
    Procedure CalcSubResult;
    Procedure CommonCreate(Const Expression:String);
    Procedure SetDecimalSeparator(Value:Char);
    {ICalculator}
    procedure SetVariable(const AName: String; const Value: Double);
    procedure TrySetVariable(const AName: String; const Value: Double);
    Function Calc:Double;
  Public
    Constructor Create(Const Expression:String);
    Constructor CreateLocale(Const Expression:String);
    Destructor Destroy;Override;
  End;{TCalculator}

Function CreateCalculator;
Begin
  Result:=TCalculator.Create(Expression);
End;{CreateCalculator}

Function CreateCalculatorLocale;
Begin
  Result:=TCalculator.CreateLocale(Expression);
End;{CreateCalculator}

procedure TCalculator.TrySetVariable(const AName: String;
  const Value: Double);
begin
  Try
    SetVariable(AName,Value);
  Except
  End;{Try}
end;

constructor TCalculator.CreateLocale(const Expression: String);
begin
  Inherited Create;
  SetDecimalSeparator(DecimalSeparator);
  CommonCreate(Expression);
end;

procedure TCalculator.CommonCreate;
begin
  FTokens:=TStringList.Create;
  Operators:=TStringList.Create;
  Results:=TDoublesStack.Create(FormatSettings);
  FExpression:=Expression;
  Parse(Expression);
end;

procedure TCalculator.SetDecimalSeparator(Value: Char);
begin
  GetLocaleFormatSettings(SysLocale.DefaultLCID,FormatSettings);
  FormatSettings.DecimalSeparator:=Value;
end;

{ TDoublesStack }

constructor TDoublesStack.Create;
begin
  Inherited Create;
  FormatSettings:=AFormatSettings;
end;

destructor TDoublesStack.Destroy;
begin
  While Count>0 Do
    Pop;
  inherited;
end;

function TDoublesStack.Pop: Double;
Var
  Popped:^Double;
begin
  Popped:=Inherited Pop;
  Result:=Popped^;
  Dispose(Popped);
end;

function TDoublesStack.Push(ADouble: Double): Double;
Var
  Pushed:^Double;
begin
  Result:=ADouble;
  New(Pushed);
  Pushed^:=Result;
  Inherited Push(Pushed);
end;

function TDoublesStack.PushString(ADouble: String): Double;
begin
  Result:=Push(StrToFloat(ADouble,FormatSettings));
end;

{ TCalculator }

function TCalculator.Calc: Double;
Var
  i:Integer;
begin
  Operators.Clear;
  While Results.Count>0 Do
    Results.Pop;
  For i:=0 To FTokens.Count-1 Do
  Begin
    If (FTokens[i]='+') Or
       (FTokens[i]='-') Or
       (FTokens[i]='*') Or
       (FTokens[i]='/') Or
       (FTokens[i]='mod') Or
       (FTokens[i]='^') Then
    Begin
      If Operators.Count=0 Then
        Operators.Add(FTokens[i])
      Else
      Begin
        If (Operators[0]='(') Or LowerPrecedence(Operators[0],FTokens[i]) Then
          Operators.Insert(0,FTokens[i])
        Else
        Begin
          CalcSubResult;
          Operators.Delete(0);
          Operators.Insert(0,FTokens[i]);
        End;{If}
      End;{If}
    End
    Else If FTokens[i]='(' Then
      Operators.Insert(0,FTokens[i])
    Else If FTokens[i]=')' Then
    Begin
      While (Operators.Count>0) And (Operators[0]<>'(') Do
      Begin
        CalcSubResult;
        Operators.Delete(0);
      End;{While}
      If Operators.Count=0 Then
        Raise ECalc.Create('Closing parenthesis not found')
      Else
        Operators.Delete(0);
    End
    Else
      Results.PushString(FTokens[i]);
  End;{For}
  While Operators.Count>0 Do
  Begin
    CalcSubResult;
    Operators.Delete(0);
  End;{While}
  If Results.Count<>1 Then
    Raise ECalc.Create('Invalid expression');
  Result:=Results.Pop;
end;

procedure TCalculator.CalcSubResult;
Var
  Left,Right:Double;
  LeftInt,RightInt:Integer;
begin
  Try
    Right:=Results.Pop;
    If (Results.Count=0) And ((Operators[0]='+') Or (Operators[0]='-')) Then {Allow Unary + And -}
      Left:=0
    Else
      Left:=Results.Pop;
  Except
    On EListError Do
      Raise ECalc.Create('Invalid expression');
  End;{Try}
  If Operators[0]='+' Then
    Results.Push(Left+Right)
  Else If Operators[0]='-' Then
    Results.Push(Left-Right)
  Else If Operators[0]='*' Then
    Results.Push(Left*Right)
  Else If Operators[0]='/' Then
    Results.Push(Left/Right)
  Else If Operators[0]='mod' Then
  Begin
    LeftInt:=Round(Left);
    RightInt:=Round(Right);
    Results.Push(LeftInt Mod RightInt);
  End
  Else If Operators[0]='^' Then
    Results.Push(Power(Left,Right));{If}
end;

constructor TCalculator.Create;
begin
  Inherited Create;
  SetDecimalSeparator('.');
  CommonCreate(Expression);
end;

destructor TCalculator.Destroy;
begin
  FTokens.Free;
  Operators.Free;
  Results.Free;
  inherited;
end;

function TCalculator.LowerPrecedence(const Operator1,
  Operator2: String): Boolean;

  Function Precedence(Operator:String):Integer;
  Begin
    If (Operator='+') Or (Operator='-') Then
      Result:=1
    Else If (Operator='*') Or (Operator='/') Or (Operator='mod') Then
      Result:=2
    Else If Operator='^' Then
      Result:=3
    Else
      Raise ECalc.Create('Unknown operator '''+Operator+'''');
  End;{Precedence}
begin
  Result:=Precedence(Operator1)<Precedence(Operator2);
end;

procedure TCalculator.Parse(const Expression: String);
Var
  i:Integer;
  Buffer:String;
begin
  i:=1;
  Buffer:='';
  FTokens.Clear;
  While (i<=Length(Expression)) Do
  Begin
    If Expression[i] In ['0'..'9','A'..'Z','a'..'z',FormatSettings.DecimalSeparator] Then
      Buffer:=Buffer+Expression[i]
    Else If Expression[i] In ['+','-','*','/','(',')','^'] Then
    Begin
      If Buffer<>'' Then
      Begin
        FTokens.Add(AnsiLowerCase(Buffer));
        Buffer:='';
      End;{If}
      FTokens.Add(AnsiLowerCase(Expression[i]));
    End
    Else If Expression[i] In [#9,' ',#13,#10] Then
      {Do Nothing}
    Else
      Raise ECalc.Create('Invalid symbol in expression: '+Expression[i]);
    Inc(i);
  End;{While}
  If Buffer<>'' Then
    FTokens.Add(AnsiLowerCase(Buffer));
end;

procedure TCalculator.SetVariable(const AName: String;
  const Value: Double);
begin
  If FTokens.IndexOf(AnsiLowerCase(AName))<0 Then
    Raise ECalc.Create('Variable "'+AName+'" not found.');
  FTokens[FTokens.IndexOf(AnsiLowerCase(AName))]:=FloatToStr(Value,FormatSettings);
end;

end.