This in an early version of what will be used in my xGrid project. It is the beginning of an expression evaluator. It can handle precedence and treats the following in order...
^ (power) || *, /, % || +, - || &
I will be adding in some bitwise operators shortly. The ampersand currently only handles text appends. Of course, paranthesis should be handled in order. Functions are also allowed and I've included some already. It's easy to add custom functions as you like and I will certainly be adding more. I've included a mechanism to allow for multiple arguments for the functions with optional arguments as needed. See the Round() function for an example.
As this will be a part of my spreadsheet/grid control, I do not handle the assignment of variables. I'll be adding in handling of Cells and Ranges for the xGrid integration and that is why there is no need for variable assignment. One cell will be contain a formula and another cell can reference that cell in it's own formula. That's not included in this version as it's a standalone expression solver.
Code: Select all
;{ To Do
; - Count the number of close paranthesis as the program loops through the expression to locate open paranthesis? To ensure
; there is an equal number of open/close paranthesis.
; - Possibly wrap the error returns into another function to let xSolve handle it? Or should I leave it for the user to handle?
; - Pass the bad function name or the starting position of the function for invalid functions?
; - Update to use doubles for calculations.
; - Pass thousands separator and update with cleaned number.
;}
;
;- Custom Functions
Procedure.s RoundTo(n.f, places)
; Code from PB&J Lover (http://forums.purebasic.com/english/viewtopic.php?t=15702)
If places < 0 : places = 0 : EndIf
r.f = 0.5 * Pow(10,-1*places) : T.f = Pow(10,places)
ProcedureReturn StrF(Int((n+r)*T)/T,places)
;
EndProcedure
;
Procedure IsNumber(inString.s, DecimalCharacter.b, ThousandsSeparator.b, *ReturnValue)
; TODO: Update to test for international decimal value and then check for IsNumeric calls to make sure they are
; international ready. Maybe need a StringToSingle call first?
;
; *ReturnValue (if a LONG address is passed) will contain a 'cleaned' version of the number. eg, no commas.
; IT MUST BE INITIALZED TO EMPTY OR OTHERWISE OR ELSE NOTHING WILL BE PASSED BACK.
;
;
HoldCleaned.s
; String used to hold the 'cleaned' value.
; The count of the decimal/thousands separator. Also the count of the numbers.
isHex.b = #False
;
; The location of the decimal/thousands separator.
IsNegative.b
; True if the value is negative.
HoldChar.b
; This will store an individual character to test if it's numeric.
*MemPosition = @inString
;
HoldLength = Len(inString)
; This will store the length of our string in characters.
Repeat
;
HoldChar = PeekB(*MemPosition)
; Store the current character.
If HoldChar > 47 And HoldChar < 58
; Numeral 0 to 9.
If CountDecimal : CountDecimalNumerics + 1 : Else : CountNumeric + 1 : EndIf
;
HoldCleaned + PeekS(*MemPosition, 1)
; Add the number to the 'clean' string.
ElseIf HoldChar = 45
; - (negative sign)
If iLoop > 0 : ProcedureReturn #False : EndIf
;
IsNegative = #True
; If the minus sign is not at the front, it's not a numeral.
HoldCleaned + PeekS(*MemPosition, 1)
; Add the negative sign to the 'clean' string.
ElseIf HoldChar = 36
; $ (hex sign)
If iLoop > 0 : ProcedureReturn #False : EndIf
; If the $ isn't at the front of the string, it's not a hex value.
isHex = #True
;
ElseIf HoldChar = ThousandsSeparator ; 44
; , (comma)
If CountDecimal Or isHex : ProcedureReturn #False : EndIf
; Never thousands after a decimal. Also, hex values never use a comma.
If CountThousands And CountNumeric < 3 : ProcedureReturn #False : EndIf
; Thousands separator requires at least three numbers.
CountNumeric = 0
; Reset the number count.
CountThousands + 1
;
ElseIf HoldChar = DecimalCharacter ; 46
; . (decimal sign)
If CountDecimal > 1 : ProcedureReturn #False : EndIf
; If there is more than one decimal, it's not an integer.
If isHex : ProcedureReturn #False : EndIf
; A hexidecimal will never have a decimal.
If CountThousands And CountNumeric < 3 : ProcedureReturn #False : EndIf
; Thousands separator requires at least three numbers.
PositionDecimal = *MemPosition - @inString
; Store the location of the decimal character.
CountDecimal + 1
; Increment our decimal count.
HoldCleaned + PeekS(*MemPosition, 1)
; Add the decimal to the 'clean' string.
Else
;
ProcedureReturn #False
; Unknown character, non-numeral.
EndIf
;
*MemPosition + 1
;
Until *MemPosition - @inString = HoldLength
;
If CountThousands And CountNumeric < 3 : ProcedureReturn #False : EndIf
; Thousands separator requires at least three numbers.
If CountDecimal And CountDecimalNumerics
;
If *ReturnValue : PokeS(*ReturnValue, HoldCleaned) : EndIf
; Return a 'cleaned' float value.
If IsNegative : ProcedureReturn -2 : Else : ProcedureReturn 2 : EndIf
; Return 2 for a float or -2 for a negative float. There must be numbers after the decimal to be considered a float.
EndIf
;
If CountNumeric
;
If *ReturnValue : PokeS(*ReturnValue, HoldCleaned) : EndIf
; Return a 'cleaned' integer value.
If IsNegative : ProcedureReturn -1 : Else : ProcedureReturn 1 : EndIf
; Return -1 for a negative integer or 1 for a positive integer.
EndIf
;
ProcedureReturn #False
; If we got this far, it must be a string.
EndProcedure
Procedure.b xs_FunctionExists(FunctionName.s, *MaxArguments, *MinArguments)
; Returns True if the function passed exists. Pass the address of the variables containing the minimum and maximum
; argument numbers and they will be returned with the correct number for the function.
FunctionName = LCase(FunctionName)
; Lower case function names for testing purposes.
If FunctionName = "round"
; The rounding function. Currently it only allows for two arguments. The first is the number to round and the second is the
; number of integers to round by. The second argument is optional and will be assumed to be 0 for demo purposes.
PokeL(*MaxArguments, 2) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "cos"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "sin"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "tan"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "acos"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "asin"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "atan"
; Accepts a single 'Angle' float argument.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "abs"
; Accepts a single numeric argument. Returns the absolute value.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "int"
; Accepts a single float argument. Returns the integer part of the float.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "log"
; Accepts a single numeric argument. Returns the log of the number.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "log10"
; Accepts a single numeric argument. Returns the log of the number in base 10.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "sqr"
; Accepts a single numeric argument. Returns the square root of the number.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "root"
; Accepts two numeric arguments. Returns the Y root of X. Code from Psychophanta (http://forums.purebasic.com/english/viewtopic.php?t=10033)
PokeL(*MaxArguments, 2) : PokeL(*MinArguments, 2)
;
ElseIf FunctionName = "isodd"
; Accepts a single integer argument. Returns 1 (True) if the number is odd or 0 (False) if the number is even.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "degrees"
; Accepts a single float argument. Converts Radians to Degrees.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "radians"
; Accepts a single float argument. Converts Degrees to Radians.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "isnumeric"
; Accepts a single argument. Returns 1 (True) if the argument is numeric (float or integer) or 0 (False) if the argument is non-numeric.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "fact"
; Accepts a single integer argument. Returns the factorial of the number. 'Fact(3)' equals '6'.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
ElseIf FunctionName = "sign"
; Accepts a single numeric argument. Returns 1 (True) if the number is negative or 0 (False) is the number is positive.
PokeL(*MaxArguments, 1) : PokeL(*MinArguments, 1)
;
Else
;
ProcedureReturn #False
;
EndIf
;
ProcedureReturn #True
;
EndProcedure
Procedure.b xs_GetMaxLevel(Expression.s)
;
Level.b = 0
; The current maximum level for the expression.
*PointerMem = @Expression
; Store the address to the first character in the expression.
HoldLength = Len(Expression)
;
Repeat
;
If PeekB(*PointerMem) = 94
; The '^' (exponent) character.
ProcedureReturn 10
; The exponent operator is the highest operator so return level 10 no matter what.
ElseIf PeekB(*PointerMem) = 42
; The '*' (multiplication) character.
If Level < 9 : Level = 9 : EndIf
;
ElseIf PeekB(*PointerMem) = 47
; The '/' (division) character.
If Level < 9 : Level = 9 : EndIf
;
ElseIf PeekB(*PointerMem) = 37
; The '%' (modulo) character.
If Level < 9 : Level = 9 : EndIf
;
ElseIf PeekB(*PointerMem) = 43
; The '+' (addition) character.
If Level < 8 : Level = 8 : EndIf
;
ElseIf PeekB(*PointerMem) = 45
; The '-' (subtraction) character.
If Level < 8 : Level = 8 : EndIf
;
ElseIf PeekB(*PointerMem) = 38
; The '"' (double quote) character.
If Level < 4 : Level = 4 : EndIf
;
EndIf
;
*PointerMem + 1
; Increment to the next character.
Until *PointerMem - @Expression = HoldLength
;
ProcedureReturn Level
; Did not find an operator.
EndProcedure
Procedure.s xs_Solve(Expression.s)
; Solve a normal expression. eg, '2 + 5.0276' will return '7.0276'.
IsFinished.b
; True when the expression is solved.
IsNumeric.b
; True if both the left and right hand values are numeric.
UpdateOperator.b
; True if we're updating the current operator. False if ignoring the operator (minus as negative sign or caught max precedence).
CaughtSpace.b
; True if the last character was a space.
OpenedQuote.b
; True if an open quote (") character is encountered. The following characters will be counted as a string.
Result.s
; The result of an operation.
Operator.b
; The ascii value of the operator. 43 ('+') in the example above - for addition.
LastIsOperator.b
; True if the last character was an operator. Used to check for double operators.
LeftHand.s
; Left hand value. The '2' in the example above.
IsLeftString.b
; True if the left hand value is a string. This overrides any pure numeric value and is only set by quotes surrounding
; the value itself. Includes any spaces in the value as well.
; The type of the left hand value. 1, -1, 2, -2 signify numeric values. 0 signifies non-numeric.
; The number of double quotes in the left hand value. Used to test for even double quotes.
LeftHandNegative.b
; True if the left hand value is negative.
RightHand.s
; Right hand value. The '7.0276' in the example above.
IsRightString.b
; See IsLeftString.
; The type of the right hand value.
; The position of the right hand value.
;
RightHandNegative.b
;
; The starting position of the current operation. One based.
; The ending position of the current operation.
HoldExpression.s = Expression
;
*PointerMem = @HoldExpression
; Store the address to the first character in the expression.
HoldLength = Len(HoldExpression)
;
ForceCalculate.b
; True if forcing the expression to calculate.
LevelCurrent.b
; The level for the current operator.
LevelMax.b = xs_GetMaxLevel(HoldExpression)
; Retrieve the highest operator precedence.
If LevelMax = 0 : ProcedureReturn HoldExpression : EndIf
; There is no expression to solve if no operators are found.
Repeat
;
UpdateOperator = #False
; Set False by default. Will be True if we're updating with a new operator.
If PeekB(*PointerMem) = 34
; The (") double quote character.
If Operator
; An operator exists - the double quote should start the right hand value.
If RightHand = ""
; The right hand value is empty so the double quote is the first character.
RightHandStart = 1
;
OpenedQuote = #True
; Let the procedure know we've just opened a double quote.
Else
;
If RightHandQuoteCount = 0 : ProcedureReturn "#ERR-BADQUOTE" : EndIf
; If we've already opened a double quote then the current double quote may be a literal double quote.
EndIf
;
RightHandQuoteCount + 1
;
Else
; Same as right hand block above.
If LeftHand = ""
PositionStart = 1
OpenedQuote = #True
Else
If LeftHandQuoteCount = 0 : ProcedureReturn "#ERR-BADQUOTE" : EndIf
EndIf
;
LeftHandQuoteCount + 1
;
EndIf
;
LastIsOperator = #False
;
EndIf
;
If PeekB(*PointerMem) = 94 Or PeekB(*PointerMem) = 42 Or PeekB(*PointerMem) = 47 Or PeekB(*PointerMem) = 37 Or PeekB(*PointerMem) = 43 Or PeekB(*PointerMem) = 45 Or PeekB(*PointerMem) = 38
; The '^' (exponent) character (94). The '*' (multiplication) character (42). The '/' (division) character (47). The '%'
; (modulo) character (37). The '+' (addition) character (43). The '-' (subtraction) character (45). The '&' (bitwise AND
; or text addition operator) character (38).
If Operator
; An operator already exists.
If LastIsOperator
; The last character was an operator.
If PeekB(*PointerMem) = 45 And RightHandNegative = #False
; The current operator is a minus sign. Assume it's a negative sign for the following right hand value.
If RightHand = "" : RightHandStart = *PointerMem - @HoldExpression + 1 : EndIf
; Store the position of the right hand value if no current right hand value exists.
RightHand = RightHand + PeekS(*PointerMem, 1)
; Add the current character to the right hand value.
RightHandNegative = #True
; Update to let the procedure know the right hand value is negative.
*PointerMem + 1
;
Continue
;
Else
; The current operator is not a negative sign.
ProcedureReturn "#ERR-DOUBLEOPERATORS"
; Return an error if two operators without values.
EndIf
;
EndIf
;
If LevelCurrent = LevelMax
; An operator already exists and it matches the highest operator level. Use it for calculation.
ForceCalculate = #True
;
Else
;
LeftHand = RightHand
; Swap the right hand value to the left hand for the new operator.
RightHand = ""
; Empty the right hand value.
PositionStart = RightHandStart
; Store the position of the new left hand value.
LeftHandQuoteCount = RightHandQuoteCount : RightHandQuoteCount = 0
; Swap the quote count.
LeftHandNegative = RightHandNegative : RightHandNegative = #False
; Update with the negative value status.
UpdateOperator = #True
; Update with the new operator.
EndIf
;
Else
; No current operator.
If PeekB(*PointerMem) = 45 And *PointerMem - @HoldExpression = 0
; Minus sign at the first position - it becomes a negative sign for the left hand value.
PositionStart = 1
; This is the first character for the left hand value.
LeftHand = "-"
; Add the current character to the left hand value.
*PointerMem + 1
;
Continue
;
Else
;
UpdateOperator = #True
; No current operator and no minus sign on the left hand value so update the operator.
EndIf
;
EndIf
;
If UpdateOperator
; Check if we're updating with the new operator.
LastIsOperator = #True
; Let the program know the last character was an operator.
Operator = PeekB(*PointerMem)
; Store the operator character.
If Operator = 94
LevelCurrent = 10
ElseIf Operator = 42 Or Operator = 47 Or Operator = 37
LevelCurrent = 9
ElseIf Operator = 43 Or Operator = 45
LevelCurrent = 8
ElseIf Operator = 38
LevelCurrent = 4
EndIf
; Update with the precedence level of the operator.
EndIf
;
ElseIf (PeekB(*PointerMem) <> 32 And OpenedQuote = #False) Or OpenedQuote = #True
; The character is part of a value so add it to the left or right hand value as needed. If a double quote is opened
; we'll need to add any empty spaces as characters.
If Operator
; An operator exists so the value will be on the right hand side.
If RightHand = "" : RightHandStart = *PointerMem - @HoldExpression + 1 : EndIf
; Store the position of the right hand value.
RightHand = RightHand + PeekS(*PointerMem, 1)
; Add the current character to the right hand value.
Else
; No operator exists. The value will be on the left hand side.
If LeftHand = "" : PositionStart = *PointerMem - @HoldExpression + 1 : EndIf
; No left hand value exists yet. Store the position of the first character. We'll use this in replacing the operation. One based.
LeftHand = LeftHand + PeekS(*PointerMem, 1)
; Add the current character to the left hand value.
EndIf
;
LastIsOperator = #False
;
EndIf
;
If (PeekB(*PointerMem) = 32 And OpenedQuote = #False) Or *PointerMem - @HoldExpression = HoldLength Or ForceCalculate = #True
; The space character or the end of the expression. If a space character, we must not have opened a double quote.
CaughtSpace = #True
;
ForceCalculate = #False
; Only set True when needed by the function.
If LevelCurrent = LevelMax
;
If Operator And LeftHand <> "" And RightHand <> ""
; Make sure we have a valid operator and left/right hand value.
PositionEnd = *PointerMem - @HoldExpression + 1
; Store the length of the current operation. One based.
LeftHandType = IsNumber(LeftHand, 46, 44, @LeftHand)
;
If LeftHandType = 0
; Non-numeric type.
IsLeftString = #True
;
If LeftHandQuoteCount = 0
;- Possibly check if the non-numeric is a cell and replace with the proper value, otherwise, error.
ProcedureReturn "#ERR-TESTQUOTES"
;
Else
;
If LeftHandQuoteCount & 1 = #True : ProcedureReturn "#ERR-UNEVENQUOTES" : EndIf
; True if an odd number of double quotes.
If PeekB(@LeftHand) = 34 And PeekB(@LeftHand + Len(LeftHand) - 1) = 34
; Check if surrounded by double quotes.
LeftHand = Mid(LeftHand, 2, Len(LeftHand) - 2)
; Remove the left and right quotes.
If LeftHandQuoteCount > 2
;
LeftHand = ReplaceString(LeftHand, Chr(34) + Chr(34), Chr(34))
;
If CountString(LeftHand, Chr(34)) <> (LeftHandQuoteCount - 2) / 2 : ProcedureReturn "#ERR-UNEVENQUOTES" : EndIf
;
EndIf
;
Else
;
ProcedureReturn "#ERR-BADSTRING"
;
EndIf
;
EndIf
;
EndIf
;
RightHandType = IsNumber(RightHand, 46, 44, @RightHand)
;
If RightHandType = 0
; Non-numeric type.
IsRightString = #True
;
If RightHandQuoteCount = 0
;- Possibly check if the non-numeric is a cell and replace with the proper value, otherwise, error.
ProcedureReturn "#ERR-TESTQUOTES"
;
Else
;
If RightHandQuoteCount & 1 = #True : ProcedureReturn "#ERR-UNEVENQUOTES" : EndIf
; True if an odd number of double quotes.
If PeekB(@RightHand) = 34 And PeekB(@RightHand + Len(RightHand) - 1) = 34
; Check if surrounded by double quotes.
RightHand = Mid(RightHand, 2, Len(RightHand) - 2)
; Remove the right and right quotes.
If RightHandQuoteCount > 2
;
RightHand = ReplaceString(RightHand, Chr(34) + Chr(34), Chr(34))
;
If CountString(RightHand, Chr(34)) <> (RightHandQuoteCount - 2) / 2 : ProcedureReturn "#ERR-UNEVENQUOTES" : EndIf
;
EndIf
;
Else
;
ProcedureReturn "#ERR-BADSTRING"
;
EndIf
;
EndIf
;
EndIf
;
If LeftHandType And RightHandType : IsNumeric = #True : Else : IsNumeric = #False : EndIf
; Test whether both left and right values are numeric.
If IsNumeric = #True
; Operator is only valid for numeric values.
If LeftHandType = 1 Or LeftHandType = -1
; The left hand value is an integer.
If RightHandType = 1 Or RightHandType = -1
; Both the left and right hand values are integers.
If Operator = 94 ; The '^' (exponent) character.
Result = StrF(Pow(Val(LeftHand),Val(RightHand)))
ElseIf Operator = 42 ; The '*' (multiplication) character.
Result = Str(Val(LeftHand) * Val(RightHand))
ElseIf Operator = 47 ; The '/' (division) character.
Result = Str(Val(LeftHand) / Val(RightHand))
ElseIf Operator = 37 ; The '%' (modulo) character.
Result = Str(Val(LeftHand) % Val(RightHand))
ElseIf Operator = 43 ; The '+' (addition) character.
Result = Str(Val(LeftHand) + Val(RightHand))
ElseIf Operator = 45 ; The '-' (subtraction) character.
Result = Str(Val(LeftHand) - Val(RightHand))
Else
;
ProcedureReturn "#ERR-UNKNOWNOPER"
;
EndIf
;
Else
; The left hand value is an integer but the right hand is a float.
If Operator = 94 ; The '^' (exponent) character.
Result = StrF(Pow(Val(LeftHand), ValF(RightHand)))
ElseIf Operator = 42 ; The '*' (multiplication) character.
Result = StrF(Val(LeftHand) * ValF(RightHand))
ElseIf Operator = 47 ; The '/' (division) character.
Result = StrF(Val(LeftHand) / ValF(RightHand))
ElseIf Operator = 37 ; The '%' (modulo) character.
ProcedureReturn "#ERR-MODULOFLOAT"
ElseIf Operator = 43 ; The '+' (addition) character.
Result = StrF(Val(LeftHand) + ValF(RightHand))
ElseIf Operator = 45 ; The '-' (subtraction) character.
Result = StrF(Val(LeftHand) - ValF(RightHand))
Else
;
ProcedureReturn "#ERR-UNKNOWNOPER"
;
EndIf
;
EndIf
;
Else
; The left hand value is a float.
If RightHandType = 1 Or RightHandType = -1
; The left hand value is a float but the right hand is an integer.
If Operator = 94 ; The '^' (exponent) character.
Result = StrF(Pow(ValF(LeftHand), Val(RightHand)))
ElseIf Operator = 42 ; The '*' (multiplication) character.
Result = StrF(ValF(LeftHand) * Val(RightHand))
ElseIf Operator = 47 ; The '/' (division) character.
Result = StrF(ValF(LeftHand) / Val(RightHand))
ElseIf Operator = 37 ; The '%' (modulo) character.
ProcedureReturn "#ERR-MODULOFLOAT"
ElseIf Operator = 43 ; The '+' (addition) character.
Result = StrF(ValF(LeftHand) + Val(RightHand))
ElseIf Operator = 45 ; The '-' (subtraction) character.
Result = StrF(ValF(LeftHand) - Val(RightHand))
Else
;
ProcedureReturn "#ERR-UNKNOWNOPER"
;
EndIf
;
Else
; Both the left and right hand values are floats.
If Operator = 94 ; The '^' (exponent) character.
Result = StrF(Pow(ValF(LeftHand), ValF(RightHand)))
ElseIf Operator = 42 ; The '*' (multiplication) character.
Result = StrF(ValF(LeftHand) * ValF(RightHand))
ElseIf Operator = 47 ; The '/' (division) character.
Result = StrF(ValF(LeftHand) / ValF(RightHand))
ElseIf Operator = 37 ; The '%' (modulo) character.
ProcedureReturn "#ERR-MODULOFLOAT"
ElseIf Operator = 43 ; The '+' (addition) character.
Result = StrF(ValF(LeftHand) + ValF(RightHand))
ElseIf Operator = 45 ; The '-' (subtraction) character.
Result = StrF(ValF(LeftHand) - ValF(RightHand))
Else
;
ProcedureReturn "#ERR-UNKNOWNOPER"
;
EndIf
;
EndIf
;
EndIf
;
Else
; Non-numeric values.
If Operator = 38
;
Result = Chr(34) + ReplaceString(LeftHand + RightHand, Chr(34), Chr(34) + Chr(34)) + Chr(34)
; Add the string with surrounding quotes and two double quotes in place of single double quotes so the result
; will be identified as a valid string for the next operation.
Else
ProcedureReturn "#ERR-UNKNOWNOPER"
EndIf
;
EndIf
;
HoldExpression = Mid(HoldExpression, 1, PositionStart - 1) + Result + Mid(HoldExpression, PositionEnd, HoldLength - PositionEnd + 1)
; Replace the operation with it's result.
*PointerMem = @HoldExpression
; Set the pointer to the beginning of the new expression.
HoldLength = Len(HoldExpression)
; Store the length of the enew expression.
LevelMax = xs_GetMaxLevel(HoldExpression)
; Get the new maximum operation level.
If LevelMax = 0
; LevelMax will be zero if no operators are found in the expression. The expression is solved.
If PeekB(@HoldExpression) = 34
;
If PeekB(@HoldExpression + Len(HoldExpression) - 1) = 34
; The result is a string. Remove the surrounding quotes and replace doubled quotes with single quotes.
HoldExpression = Mid(HoldExpression, 2, Len(HoldExpression) - 2)
;
HoldExpression = ReplaceString(HoldExpression, Chr(34)+Chr(34), Chr(34))
;
EndIf
;
EndIf
;
ProcedureReturn HoldExpression
;
EndIf
;
LevelCurrent = 0
; Reset the current operation level to zero.
Operator = 0
; Reset the current operator to show no operator.
LeftHand = ""
IsLeftString = #False
; Reset the left hand values.
RightHand = ""
IsRightString = #False
; Reset the right hand values.
CaughtSpace = #False
;
OpenedQuote = #False
; Reset our opened quote identifier.
LeftHandQuoteCount = 0 : RightHandQuoteCount = 0
; Reset the left/right value quote count.
LeftHandNegative = #False : RightHandNegative = #False
; Reset the negative value identifier.
LastIsOperator = #False
;
Continue
; Reset the loop. This will skip over the *PointerMem + 1 increment at the end of the loop and cause the loop
; to begin evaluation at the beginning of the expression.
EndIf
;
EndIf
;
If *PointerMem - @HoldExpression = HoldLength : IsFinished = #True : EndIf
; Reached the end of the expression.
EndIf
;
*PointerMem + 1
; Increment to the next character.
Until IsFinished = #True
;
ProcedureReturn HoldExpression
; Return the result - should be held in HoldExpression.
EndProcedure
Procedure.s xs_SolveFunction(FunctionName.s, Arguments.s, ArgumentCount)
; Return the rsult for the function and arguments.
HoldString.s
; Temporary string used for arguments.
; Simple looping variable.
; Number type for arguments.
; Temporary long value used for arguments.
fHold.f
; Temporary float value used for arguments.
FunctionName = LCase(FunctionName)
;
If FunctionName = "round"
;
HoldString = StringField(Arguments, 1, ",")
;
lType = IsNumber(HoldString, 46, 0, @HoldString)
; Get the type of the first argument - clean it if necessary.
If lType = 0 : ProcedureReturn "#ERR-FUNCTIONREQUIRESNUMERIC" : EndIf
; Can't round a non-numeric.
If lType = -1 Or lType = 1 : ProcedureReturn HoldString : EndIf
; If the first argument is an integer, there's no need to round.
fHold = ValF(HoldString)
;
If ArgumentCount = 2
; Test the second argument.
HoldString = StringField(Arguments, 2, ",")
;
lType = IsNumber(HoldString, 46, 0, 0)
;
If lType = 0 : ProcedureReturn "#ERR-FUNCTIONREQUIRESNUMERIC" : EndIf
;
If lType = -2 Or lType = 2 : ProcedureReturn "#ERR-FUNCTIONREQUIRESINTEGER" : EndIf
; The second argument must be an integer.
EndIf
;
If ArgumentCount = 1
; Only passed the number to round.
ProcedureReturn RoundTo(fHold, 0)
; Round to zero places if no second argument was passed.
Else
;
ProcedureReturn RoundTo(fHold, Val(StringField(Arguments, 2, ",")))
; Round to the passed number of decimal places.
EndIf
;
ElseIf FunctionName = "cos"
;
ProcedureReturn StrF(Cos(ValF(Arguments)))
;
ElseIf FunctionName = "sin"
;
ProcedureReturn StrF(Sin(ValF(Arguments)))
;
ElseIf FunctionName = "tan"
;
ProcedureReturn StrF(Tan(ValF(Arguments)))
;
ElseIf FunctionName = "acos"
;
ProcedureReturn StrF(ACos(ValF(Arguments)))
;
ElseIf FunctionName = "asin"
;
ProcedureReturn StrF(ASin(ValF(Arguments)))
;
ElseIf FunctionName = "atan"
;
ProcedureReturn StrF(ATan(ValF(Arguments)))
;
ElseIf FunctionName = "abs"
;
ProcedureReturn StrF(Abs(ValF(Arguments)))
;
ElseIf FunctionName = "int"
;
ProcedureReturn Str(Int(ValF(Arguments)))
;
ElseIf FunctionName = "log"
;
ProcedureReturn StrF(Log(ValF(Arguments)))
;
ElseIf FunctionName = "log10"
;
ProcedureReturn StrF(Log10(ValF(Arguments)))
;
ElseIf FunctionName = "sqr"
;
ProcedureReturn StrF(Sqr(ValF(Arguments)))
;
ElseIf FunctionName = "root"
;
ProcedureReturn StrF(Pow(ValF(StringField(Arguments, 1, ",")), 1 / ValF(StringField(Arguments, 2, ","))))
;
ElseIf FunctionName = "isodd"
;
lType = IsNumber(Arguments, 46, 0, @Arguments)
;
If lType = 0 Or lType = 2 Or lType = -2 : ProcedureReturn "#ERR-FUNCTIONREQUIRESINTEGER" : EndIf
; IsOdd requires an integer.
ProcedureReturn Str(Val(Arguments) & 1)
;
ElseIf FunctionName = "degrees"
;
ProcedureReturn StrF(ValF(Arguments) * 57.2957795)
; Thanks Google Calculator! :D
ElseIf FunctionName = "radians"
;
ProcedureReturn StrF(ValF(Arguments) * 0.01745329)
; And again! :D Warning - original number should be '0.0174532925' but PB gives a 'number too big' error so truncated :(
ElseIf FunctionName = "isnumeric"
;
lType = IsNumber(Arguments, 46, 0, 0)
; Retrieve the numeric type of the argument. Returns 0 if non-numeric.
If lType = 0 : ProcedureReturn "0" : Else : ProcedureReturn "1" : EndIf
;
ElseIf FunctionName = "fact"
;
lType = IsNumber(Arguments, 46, 0, @Arguments)
;
If lType = 0 Or lType = 2 Or lType = -2 : ProcedureReturn "#ERR-FUNCTIONREQUIRESINTEGER" : EndIf
; Requires an integer argument.
lHold = Val(Arguments)
;
For iLoop = 1 To Val(Arguments) - 1 : lHold * iLoop : Next iLoop
;
ProcedureReturn Str(lHold)
;
ElseIf FunctionName = "sign"
;
lType = IsNumber(Arguments, 46, 0, 0)
; Retrieve the numeric type of the argument. Returns -1 (negative integer) or -2 (negative float) or 0 (non-numeric).
If lType = 0 : ProcedureReturn "#ERR-FUNCTIONREQUIRESNUMERIC" : EndIf
; Requires an integer argument.
If lType = -1 Or lType = -2 : ProcedureReturn "1" : Else : ProcedureReturn "0" : EndIf
;
Else
;
;
EndIf
;
EndProcedure
Procedure.s xEvaluate(Expression.s)
;
; Simple looping variable.
HoldString.s
; Temporary string variable.
PositionBegin = -1
; The position of the current open paranthesis.
PositionEnd = -1
; The position of the current close paranthesis.
; Temporary looping variable to test for various things (eg, function names).
HoldLength = Len(Expression)
; The length of the expression.
lPosition = HoldLength
; The current read position.
HoldExpression.s = Expression
; Used to temporarily store the expression as it's processed.
*PointerMem = @HoldExpression + HoldLength - 1
; Store the address of the last character in the expression.
HoldEquation.s
; Temporarily stores an equation within the paranthesis to solve.
HoldFunction.s
; Store the function name for an expression.
HoldResult.s
; Stores the results for solved expressions.
HoldArguments.s
; Stores the arguments for a function within the expression. eg, 'Round(2.6622, 2)' will contain '2.6622, 2'
NewArguments.s
; Stores solved arguments.
; The total number of arguments allowed for a function within the expression. This includes the optional arguments.
; The total number of required arguments for a function within the expression. Does not include optional arguments.
; Store the number of arguments for a function in the expression.
IsFinished.b
; True when the expression is solved.
Repeat
;
While PeekB(*PointerMem) <> 40 And *PointerMem >= @HoldExpression
; Locate the first open paranthesis.
lPosition - 1
; Update the current read position as we loop through the expession.
If PeekB(*PointerMem) = 41 : PositionEnd = lPosition : EndIf
;
*PointerMem - 1
;
Wend
;
If PeekB(*PointerMem) = 40
; Located an open paranthesis.
PositionBegin = lPosition - 1
; Zero based positions.
If PositionEnd = -1 : ProcedureReturn "#ERR-CLOSEPARAN-"+Str(PositionBegin) : EndIf
; There must be a close paranthesis to the open paranthesis. Return an error code with the open paranthesis position.
If PositionBegin > 0 And PeekB(@HoldExpression + PositionBegin - 1) <> 32
; No function name can exist for the paranthesis if the open paranthesis is the first character. If no
; space in front of the open paranthesis, it should be a function.
*PointerMem - 1
; Move seek position to the character before the open paranthesis.
While PeekB(*PointerMem) >= 48 And PeekB(*PointerMem) <= 122 And *PointerMem >= @HoldExpression : *PointerMem - 1 : Wend
; Loop backward through the expression to find the start of the function name in front of the open paranthesis. A valid
; function name is anything with a letter or a number.
HoldFunction = Mid(HoldExpression, *PointerMem - @HoldExpression + 2, PositionBegin - (*PointerMem - @HoldExpression) - 1)
; Add two to the start to correct for the while-wend loop decrementing and to adjust for a one based position.
If xs_FunctionExists(HoldFunction, @ArgumentMax, @ArgumentMin) = #False
; The function passed does not exist as a valid function.
ProcedureReturn "#ERR-INVFUNCTION-"+HoldFunction
; Return an 'invalid function' error code with the function name in question.
EndIf
; Past this point we should have a valid function name with the number of arguments for the function. The next step
; is to check the number of passed arguments to make sure the minimum arguments requirement is met and then to evaluate
; the function arguments.
HoldArguments = Mid(HoldExpression, PositionBegin + 2, PositionEnd - PositionBegin - 1)
; Retrieve the arguments for the function. Add two to PositionBegin for one based positions and to skip the open
; paranthesis. Subtract one for the length to allow for the closed paranthesis position.
CountArguments = CountString(HoldArguments, ",") + 1
; Store the number of arguments for the function. Add one for one based calculations.
If CountArguments < ArgumentMin : ProcedureReturn "#ERR-MINARGUMENT-"+HoldFunction : EndIf
; The number of function arguments must at least contain the minimum required for the function.
If CountArguments > ArgumentMax : ProcedureReturn "#ERR-MAXARGUMENT-"+HoldFunction : EndIf
; The number of function arguments may not exceed the total number of arguments for the function.
For iLoop = 1 To CountArguments
; Loop through the arguments.
If iLoop = 1
; At the first argument.
NewArguments = xs_Solve(StringField(HoldArguments, iLoop, ","))
; Solve any expression within the argument field and add it to our new argument list.
If Left(NewArguments, 4) = "#ERR" : ProcedureReturn NewArguments : EndIf
; Immediately return any error condition.
Else
;
HoldString = xs_Solve(StringField(HoldArguments, iLoop, ","))
;
If Left(HoldString, 4) = "#ERR" : ProcedureReturn HoldString : EndIf
;
NewArguments = NewArguments + "," + HoldString
;
EndIf
;
Next iLoop
;
HoldResult = xs_SolveFunction(HoldFunction, NewArguments, CountArguments)
; Return the result of the function.
If Left(HoldResult, 4) = "#ERR" : ProcedureReturn HoldResult : EndIf
; Immediately return any error condition.
HoldExpression = Mid(HoldExpression, 1, *PointerMem - @HoldExpression + 1) + HoldResult + Mid(HoldExpression, PositionEnd + 2, Len(HoldExpression) - PositionEnd)
; Update the expression with the new result, replacing the old function.
PositionBegin = -1
;
PositionEnd = -1
;
HoldLength = Len(HoldExpression)
;
lPosition = HoldLength
;
*PointerMem = @HoldExpression + HoldLength - 1
;
Else
; The paranthesis encloses a non-function expression. Solve it.
HoldEquation = Mid(HoldExpression, PositionBegin + 2, PositionEnd - PositionBegin - 1)
; Store the equation within the paranthesis.
HoldResult = xs_Solve(HoldEquation)
; Solve the equation.
If Left(HoldResult, 4) = "#ERR" : ProcedureReturn HoldResult : EndIf
; Immediately return any error condition.
HoldExpression = Mid(HoldExpression, 1, PositionBegin) + HoldResult + Mid(HoldExpression, PositionEnd + 2, Len(HoldExpression) - PositionEnd)
; Update the expression with the new result, replacing the equation within the paranthesis.
PositionBegin = -1
;
PositionEnd = -1
;
HoldLength = Len(HoldExpression)
;
lPosition = HoldLength
;
*PointerMem = @HoldExpression + HoldLength - 1
;
EndIf
;
Else
;
HoldExpression = xs_Solve(HoldExpression)
;
If Left(HoldExpression, 4) = "#ERR" : ProcedureReturn HoldExpression : EndIf
; Immediately return any error condition.
IsFinished = #True
;
EndIf
;
Until IsFinished = #True
;
ProcedureReturn HoldExpression
;
EndProcedure
a.s = "(2 + 2)"
;a.s = "2.35 / 10 + 20 * 5.25 / 1.22"
;a.s = "2 + (5*round(2 + 5.0276, 2) + 5) * 10"
;a.s = "2 + 2 * 5 + -10&"+Chr(34)+" Test"+Chr(34)
b.s = xEvaluate(a)
Debug "'"+a+"' = "+bStrings are handled simple at the moment. They must be surrounded in double quotes for the function to recognize it as a string. The reason is, cells and ranges will be like A2 or A2:B10 without quotes. I needed a way to separate them. So you can have an expression like ("A"&2.5+2) and the result should be A4.5. If you want to display a double quote, use two double quotes in a row. The string part is weak at the moment. Sorry
I've tried to include a lot of comments so you can see what's happening and I've tried to keep it simple and clean but ... well ^_^
Give it a shot and pass bugs my way. Maybe let me know what you think and if it works well for you.
