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.