Calculator
by Christopher Winward: U6 Age ~17
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.