Calculator

Introduction

Christopher's calculator, now available for the web, will evaluate expressions comprising integers and/or fixed-point real numbers with the operators +, -, *, / and ^ and brackets. It will accept a leading minus (the unary minus) for a negative first number in the expression, but will not accept a negative exponent or white spaces. Christopher has done the hard work and leaves it up to you to perfect it. The program outputs helpful error messages if the syntax of the expression is incorrect. This screenshot shows both correct results of calculations and error messages for faulty input.

Output from calculator showing correct calculations and error messages

As usual, Christopher uses object-oriented code. We reproduce the following paragraph from Christopher's ample comments.

"This is an implementation of the shunting-yard algorithm that makes use of stacks to convert infix equations into postfix. As Pascal does not have a built-in stack, I just used a modified tList to act in a similar manner."

Christopher cites a useful Wikipedia page that you can consult in order to understand his implementation of the algorithm.

Download the source code in calculator.txt.

The Program

program Calculator;
{
    Copyright (c) 2012 Christopher Winward

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
{$mode objfpc}{$H+}
{$Apptype Console}
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,  math, sysUtils;

type
  tTokenNames = (TOKEN_NONE, TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                 TOKEN_LBRACK, TOKEN_RBRACK, TOKEN_POWER, TOKEN_NUMBER, TOKEN_END, TOKEN_INVALID);
  tToken = class
  public
    eType : tTokenNames; //The eType describes the token type, such as TOKEN_ADD or TOKEN_NUMBER
    eValue : double; //The numerical value of the token, only used if eType is TOKEN_NUMBER
    constructor Create(xType : tTokenNames; xValue : double = 0);
  end;
  tTokenList = class(tList) //We're just expanding upon the tList class to add our own methods.
  public                       //A tList is like an advanced array of pointers
    //Returns a typecasted object -> tToken from the list at a given position
    function at(position : integer) : tToken;

    //Returns the last tToken in the list
    function getLast : tToken;

    function getSecondLast : tToken;
    function getFirst : tToken;

    //Removes the last tToken from the list, and returns it
    function popData : tToken;

    //Returns FALSE if a TOKEN_INVALID is found anywhere in it, otherwise TRUE
    function isValid : boolean;

    //Print all the data in the list straight out to the console
    procedure dumpData;
  end;

constructor tToken.Create(xType : tTokenNames; xValue : double = 0);
begin
  eType := xType;
  eValue := xValue;
end;

function tTokenList.at(position : integer) : tToken;
begin
  //Typecast a pointer to a tToken pointer and return it
  exit(tToken(self.Get(position)));
end;

function tTokenList.getLast : tToken;
begin
  exit(tToken(self.last));
end;

function tTokenList.getSecondLast : tToken;
begin
  exit(self.at(self.Count - 2));
end;

function tTokenList.getFirst : tToken;
begin
  exit(tToken(self.first));
end;

function tTokenList.isValid : boolean;
var
  tCount : integer;
begin
  for tCount := 0 to self.Count - 1 do
  //Simply check all the tokens and return false if any are TOKEN_INVALID
  begin
    if self.at(tCount).eType = TOKEN_INVALID then
      exit(false);
  end;
  exit(true);
end;

//Dump out the data in a tokenList, mostly for debugging purposes
procedure tTokenList.dumpData;
var
  i : integer;
begin
  for i:= 0 to self.count - 1 do
    begin
      writeln(i, ': ', self.at(i).eType,' ', self.at(i).eValue);
    end;
  writeln;
end;

function tTokenList.popData : tToken;
begin
  result := self.getLast;
  self.Remove(self.Last);
end;

//Look at a string, and convert it into a tTokenList of tTokens
function stringToTokens(inputString : string) : tTokenList;

  //We nest a few functions in here as they aren't needed elsewhere
  function checkStringNumber(inputString : string) : boolean;
  var
    charCount, decCount : integer;
  begin
    //Just check that we have a valid number with only one decimal place
    decCount := 0;
    for charCount := 1 to length(inputString) do
      begin
        if (inputString[charCount] = '.') then
          begin
            inc(decCount);
            if (decCount = 2) then //We've found a second decimal place, so it's not valid
              exit(false);
      end;
    end;
    exit(true);
  end;

  procedure exitFail;
  begin
    result.Add(tToken.Create(TOKEN_INVALID));
    result.Add(tToken.Create(TOKEN_END));
  end;

var
  charCount, tokenCount : integer;
  tempChar : char;
  strTempNumber : string = '';
  dblTempNumber : double;
  lBrackCount, rBrackCount : integer; //For counting left and right brackets
begin
  lBrackCount := 0;
  rBrackCount := 0;
  result := tTokenList.Create; //Create a new tTokenList and set the result to it.
  if (length(inputString) = 0) then
    exitFail; //If no input is entered, fail
  for charCount := 1 to length(inputString) do //Loop through all the characters in the string.
    begin
      tempChar := inputString[charCount];
      //Add the character to a temporary number string if it's a digit or decimal point.
      if tempChar in ['0' .. '9', '.'] then
        begin
          strTempNumber += tempChar;
        end
      else
        begin //If not a digit or .
          if length(strTempNumber) <> 0 then //If there is a number string to evaluate
            begin
              if checkStringNumber(strTempNumber) then //Check it's a valid number
                dblTempNumber := StrToFloat(strTempNumber)
              else
                begin
                  dblTempNumber := 0; //If not, exit fail
                  writeln('Could not convert number properly.');
                  exitFail;
                end;
              //Add the number to the token list
              result.Add(tToken.Create(TOKEN_NUMBER, dblTempNumber));
              strTempNumber := ''; //Clear the temporary number
            end;

          case tempChar of //If it's an operator, add it to the token list
            '+' : result.Add(tToken.Create(TOKEN_ADD));
            '-' : result.Add(tToken.Create(TOKEN_SUBTRACT));
            '*' : result.Add(tToken.Create(TOKEN_MULTIPLY));
            '/' : result.Add(tToken.Create(TOKEN_DIVIDE));
            '(' : begin
                    result.Add(tToken.Create(TOKEN_LBRACK));
                    inc(lBrackCount);
                  end;
            ')' : begin
                    result.Add(tToken.Create(TOKEN_RBRACK));
                    inc(rBrackCount);
                  end;
            '^' : result.Add(tToken.Create(TOKEN_POWER));
          else
            begin
              writeln('Invalid characters used in statement.');
              exitFail;
            end;
          end;
        end;
    end;
  if rBrackCount <> lBrackCount then //Unequal numbers of left and right brackets
    begin
      writeln('Mismatched brackets');
      exitFail;
    end;
  //Check the current temporary number string one last time.
  if length(strTempNumber) <> 0 then
    begin
      if checkStringNumber(strTempNumber) then
        begin
          dblTempNumber := StrToFloat(strTempNumber);
          result.Add(tToken.Create(TOKEN_NUMBER,dblTempNumber));
        end
      else
        begin
          dblTempNumber := 0;
          writeln('Could not convert number properly.');
          exitFail;
        end;
    end;

  //Now run a syntax analysis to check that it's safe to run.
  if (result.getLast.eType <> TOKEN_NUMBER) and (result.getLast.eType <> TOKEN_RBRACK) then
    begin //The expression must end in a number or right bracket.
      exitFail;
    end;
  if (result.getFirst.eType <> TOKEN_NUMBER) and (result.getFirst.eType <> TOKEN_LBRACK) then
    begin //Check it starts with a number or left bracket.
      if (result.getFirst.eType = TOKEN_SUBTRACT) or (result.getFirst.eType = TOKEN_ADD) then
        begin
          //Add a 0 before any leading plus or minus signs.
          result.Insert(0, tToken.create(TOKEN_NUMBER, 0));
        end
      else
    begin
      writeln('Syntax error - calculation doesn''t start with a number.');
      exitFail;
    end;
  end;

  for tokenCount := 1 to result.Count - 1 do
    begin
      case result.at(tokenCount).eType of
        TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
        TOKEN_POWER :  begin
                         if not(result.Count = tokenCount) then
                           begin
                             if ((result.at(tokenCount - 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount - 1).eType <> TOKEN_RBRACK))
                                or
                                ((result.at(tokenCount + 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount + 1).eType <> TOKEN_LBRACK)) then
                                //Check that operators have numbers or appropriate brackets around them
                               begin
                                 if result.at(tokenCount-1).eType <> TOKEN_NUMBER then
                                   begin
                                     //Add a leading zero before + and -
                                     result.insert(tokenCount,tToken.create(TOKEN_NUMBER, 0));
                                   end
                                 else
                                   begin
                                     writeln('Bad tokens around ADD, SUBTRACT, MULTIPLY, DIVIDE or POWER sign');
                                     exitFail;
                                   end;
                               end;
                           end
                         else
                           begin
                             writeln('Ends with a binary operator.');
                             exitFail;
                           end;
                       end;
        TOKEN_LBRACK : begin
                       {Check that after a left bracket there is a number,
                       another left bracket, or a right bracket}
                         if (result.at(tokenCount+1).eType <> TOKEN_NUMBER) and
                            (result.at(tokenCount+1).eType <> TOKEN_LBRACK) and
                            (result.at(tokenCount+1).eType <> TOKEN_RBRACK) then
                           exitFail;
                       end;
      end;
    end;
  result.Add(tToken.Create(TOKEN_END));
end;

function convertInfixToPostfix(inputList : tTokenList) : tTokenList;
{This is an implementation of the Shunting-yard algorithm that makes use of stacks to convert
infix equations into postfix. As Pascal does not have a built in stack, I just used a modified
tList to act in a similar manner.
http://en.wikipedia.org/wiki/Shunting-yard_algorithm gives a good overview of the algorithm.
I haven't commented this function as it doesn't deviate away from the algorithm much if at all,
and I will assume you have read the Wikipedia article explaining it.}
var
  tempToken : tToken;
  outputTokenList : tTokenList;
  temporaryStack : tTokenList;
  tokenCount : integer;
begin
  outputTokenList := tTokenList.create;
  temporaryStack := tTokenList.create;
  temporaryStack.add(tToken.create(TOKEN_END));
  for tokenCount := 0 to inputList.count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        //These don't need any special cases, they go straight to the output.
        TOKEN_NUMBER :   outputTokenList.Add(tempToken);

        TOKEN_ADD,
        TOKEN_SUBTRACT : begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER, 0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_MULTIPLY,
        TOKEN_DIVIDE :   begin
                           case temporaryStack.getLast.eType of
                             TOKEN_MULTIPLY, TOKEN_DIVIDE,
                             TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                           end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_POWER :    begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER,0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_LBRACK :   temporaryStack.Add(tempToken);
        TOKEN_RBRACK :   begin
                           while temporaryStack.getLast.eType <> TOKEN_LBRACK do
                             outputTokenList.add(temporaryStack.popData);
                           temporaryStack.popData;
                         end;
        TOKEN_END :      while temporaryStack.Count <> 0 do
                           outputTokenList.add(temporaryStack.popData);
      end;
    end;
  exit(outputTokenList);
end;

//Just push the tokens onto a stack, evaluating the operands when they appear.
function evaluateRPN(inputList : tTokenList) : double;
var
  tempToken : tToken;
  stack : tTokenList; //A temporary stack for holding values to use operators on later
  tokenCount : integer;
  tempDouble : double;
begin
  stack := tTokenList.Create;
  for tokenCount := 0 to inputList.Count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        TOKEN_NUMBER :   stack.Add(tempToken);
                         //Add the top two values on the stack together.
        TOKEN_ADD :      stack.getSecondLast.eValue += stack.popData.eValue;
        TOKEN_SUBTRACT : stack.getSecondLast.eValue -= stack.popData.eValue;
        TOKEN_MULTIPLY : stack.getSecondLast.eValue *= stack.popData.eValue;
        TOKEN_DIVIDE :   stack.getSecondLast.eValue /= stack.popData.eValue;
        TOKEN_POWER :    //Raise the second last value to the power of the last value on the stack.
                         begin
                           tempDouble := stack.getSecondLast.eValue ** stack.getLast.eValue;
                           stack.popData; //Use a temporary variable so we can pop the data.
                           stack.getLast.eValue := tempDouble;
                         end;
      end;
    end;
  if (stack.Count <> 1) then
    writeln('Could not properly evaluate statement. The following result is unreliable.');
  exit(stack.at(0).eValue);
end;

var
  inputString : string;
  tokensToEvaluate, postfixTokens : tTokenList;
begin
  tokensToEvaluate := tTokenList.create;
  writeln('Please enter a standard calculation.');
  while true do
    begin
      write('>>> ');
      readln(inputString);
      if (inputString = 'exit') then
        break;
      tokensToEvaluate := stringToTokens(inputString);
      if tokensToEvaluate.isValid then //Check the strings uses valid tokens.
        begin
          postfixTokens := convertInfixToPostfix(tokensToEvaluate);
          if (postfixTokens.isValid) then //Check that after conversion, it is still valid.
            writeln(floatToStr(evaluateRPN(postfixTokens)))
          else
            writeln('Syntax error.');
        end
      else
        begin
          writeln('Syntax error.');
        end;
    end;
end.