' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Math Expressions Analyzer V.1.1 '
' '
' Module to get a string, analyze it mathematically and '
' issuing a result from the operation. If you are using '
' QuickBASIC with a project, please ensure to include the '
' FUNCTION declarations at the top of each file on it. '
' Failing to do so can bring no results in the analysis. '
' '
' Originally created in Visual Basic 4.0 and translated '
' into QBASIC/QB/VB-DOS/QB64 by A. David Garza Marin. '
' e-mail: adgarza@yahoo.com '
' PRO-3, Mexico '
' ******************************************************* '
' You are free to use and modify this code to adapt it '
' to your own needs. But, please, don't remove my credit. '
' It took many hours for its creation and I think I '
' deserve such credit. '
' '
' Please, send to me an email to adgarza@yahoo.com to '
' report errors or commends about this code. '
' ******************************************************* '
' MODIFICATIONS: '
' '
' Date(d/m/y)| Revision '
' --------+---------------------------------------------- '
' 01/01/97| Development started. '
' 16/06/97| Added an Error member data that takes control '
' | of runtime errors in the methods. '
' 18/06/97| Error code 8, "Cannot divide by zero" added. '
' 14/12/98| Bugs corrected on operations with signed nums.'
' 15/12/98| CalculaFormula method added. This method gets '
' | rid of spaces and verifies the sign-law. '
' | This addition was done by Alejandro Juarez B. '
' 15/12/98| Function CalculaFormula made private. '
' | (adgarza). '
' 21/05/99| Translation into QBASIC and QuickBASIC. '
' | (adgarza). '
' 12/08/20| Translation into QB64 '
' 13/08/20| Fixed calculation problem with long expression'
' | starting with a blank space. '
' 26/08/20| Fixed a logical error where a long result in '
' | an operation would bring an unexpected '
' | scientific notation that crashed the program.'
' | Fixed a logical error when multiplying or '
' | dividing two negative numbers the + sign was '
' | missing. '
' | Added * signs when a parentheses is trailed '
' | or followed directly with a number or with a '
' | closing parentheses following by an open one '
' | and vice-versa '
' | There is an apparent error in QB64 where some '
' | floating point numbers assigned to variables '
' | of type DOUBLE are forcibly converted to '
' | scientific notation by adding a decimal '
' | number distinct to zero at the end of the '
' | decimals. This was worked around with a '
' | sub-process that removes the scientific '
' | notation through string manipulation, as '
' | there is no way to remove it numerically. '
'
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' $DYNAMIC
' -----Copy these declarations in your modules ----
' -----Copy should be up to here. It is not necessary to copy the rest of the declarations
' ******** Local Functions *********************
' ************************************************
' 32-bit value
DIM aregVariables
(0 TO 0) AS RegistroVar
' Operation variables
' Constants
' ********* Main program cycle ********
' Run the following procedure before any other
Constructor
c = TRUE
' Sees if it is a test file
' THIS ONLY WORKS IN QB64
IF FILEEXISTS
("TESTMEA.TXT") THEN tf = TRUE
tf = FALSE
' Repeat until you get an N
PRINT "This program interprets simple mathematical expressions. Write" PRINT "one at the prompt and press Enter to see the results. Read the" PRINT "file README.TXT for further details. You can use" PRINT "variables in the expression." doLimpiaVar ' Clean variables
strCadena = ""
tf = FALSE
INPUT "Expression to evaluate"; strCadena
' Gets the string
setExpresion strCadena ' Assigns the string to the module
getObtieneVar ' Gets variables
x = CuentaVar ' Count how many variables the expression has
IF x
> 0 THEN ' If variables found, ask for their values. FOR i
= 1 TO x
' Loop for each variable found. PRINT "Value of " + NombreVar
(i
);
' Show the variable name to request its value INPUT dblValor
' Capture the value setNuevoValor
LTRIM$(STR$(i
)), dblValor
' Assign the value to the variable PRINT "Result of: "; strCadena
PRINT USING "###,###,###,###.####"; AnalizaExpr
' Show the result
IF CErr
> 0 THEN ' Is any error happened? PRINT "Error" + STR$(CErr
) + ": " + DErr
' Show the error message
PRINT "Again? (Y/N)" ' Want to try again? t = "Y"
' Even though is not strictly necessary, it is advised to
' free the resources used by the module
Destructor
PRINT "End of program" ' End of the program execution
' Public procedure to set if the formula analysis should be done.
' Var
iError = 0
strExpresion
= RTRIM$(LTRIM$(strExpresion
)) ' Removes spaces IF SinAcentos
(strExpresion
) THEN IF CuentaVar%
= 0 THEN ' Just if there are no variables getObtieneVar ' Verifies if there are variables, just in case
strFormula = SustituyeVars ' Substitues variables
AnalizaExpr = LimpiaFormula(strFormula)
iError = 4
AnalizaExpr = 0
iError = 5
AnalizaExpr = 0
' Var
i = 0
i = i + 1
i = 0
BuscaVar = i
' Do the formula analysis
' Var
CONST strSimbolo
= "^^*/+-" ' Recognized symbols (From most important to least important)
' Calculates the formula
iError = 0
strCar = ""
iPosParI
= INSTR(iPosParI2
(iCuantosI
) + 1, strFormula
, "(") iPosParD
= INSTR(iPosParI2
(iCuantosI
) + 1, strFormula
, ")") iPosParI
= INSTR(strFormula
, "(") iPosParD
= INSTR(strFormula
, ")")
' Runs the code according the parentheses location
iCuantosI = iCuantosI + 1
' Validates if the previous character of the opening parentheses is a number
' if so, then add the asterisc
strCar
= MID$(strFormula
, iPosParI
- 1, 1) strFormula
= LEFT$(strFormula
, iPosParI
- 1) + "*" + MID$(strFormula
, iPosParI
) iPosParI = iPosParI + 1
iPosParI2(iCuantosI) = iPosParI
strCar
= MID$(strFormula
, iPosParD
+ 1, 1) ' Validates if the following character of the closing parentheses is a number. if so
' then adds an asterisc.
strFormula
= LEFT$(strFormula
, iPosParD
) + "*" + MID$(strFormula
, iPosParD
+ 1)
IF iPosParI2
(iCuantosI
) > 0 THEN strSubFormula
= MID$(strFormula
, iPosParI2
(iCuantosI
) + 1, iPosParD
- iPosParI2
(iCuantosI
) - 1) PRINT "strFormula="; strFormula
PRINT "strSubFormula="; strSubFormula
strFormula
= LEFT$(strFormula
, iPosParI2
(iCuantosI
) - 1) + strSubFormula
+ MID$(strFormula
, iPosParD
+ 1) iCuantosI = iCuantosI - 1
iError = 6 ' Parentheses mismatch
iError = 6 ' Parentheses mismatch
iError = 6 ' Parentheses mismatch
strSubFormula = strFormula
PRINT "strFormula="; strFormula
PRINT "strSubFormula="; strSubFormula
strFormula = strSubFormula
iCuantosI = 0
CalculaFormula
= VAL(strFormula
)
HazLaOperacion:
' Do the operation
iOperacion = 1
strSigno
= MID$(strSimbolo
, (2 * (iOperacion
- 1) + 1), 2)
' If one of these operators ( ^^ */ +- ) is inside the operation
' If the first operator exists (^*+) and is before the second one (^/-)
iPos = iOper1
strOperacion
= LEFT$(strSigno
, 1)
' If the second operator (^/-) exists
iPos = iOper1
strOperacion
= LEFT$(strSigno
, 1)
' If the second operator (^*+) exists and is after the second (^/-)
' If the first character on the formula is a negative sign, do the operation with the operator at the left (^*+)
iPos = iOper1
strOperacion
= LEFT$(strSigno
, 1) ELSE ' Else, do the operation with the operator at the right (^/-) iPos = iOper2
strOperacion
= RIGHT$(strSigno
, 1) ' The operation will be done with the right-side operator (^/-)
strOperacion
= RIGHT$(strSigno
, 1)
' But if the first character is a negative sign, do the operation with the operator at the right-side (^/-)
iPos
= INSTR(iOper2
+ 1, strSubFormula
, strOperacion
) iPos = iOper2
' If it is 1 is very likely that is a number with negative sign
strASuma = ""
dblNum1 = NumIzq(strSubFormula, iPos, iPosI)
dblNum2 = NumDer(strSubFormula, iPos, iPosD)
PRINT "dblNum1: "; dblNum1;
"dblNum2: "; dblNum2
CASE "^": dblRes
= dblNum1
^ dblNum2
dblRes = dblNum1 * dblNum2
strASuma = "+"
iError = 8
dblRes = 0
dblRes = dblNum1 / dblNum2
strASuma = "+"
CASE "+": dblRes
= dblNum1
+ dblNum2
CASE "-": dblRes
= dblNum1
- dblNum2
' Removes scientific notation if any
dblRes
= CDBL(CLNG(dblRes
* 1000000) / 1000000) GOSUB RemoverNotacionCientifica
IF Debug
THEN PRINT "I removed the scientific notation."
PRINT "dblRes:"; dblRes;
"strRes: "; strRes
' If the first character is a negative sign and the operation is an addition
' If the operator position is greater than 1
IF iPosI
> 1 THEN ' There is a negative number at left-side, so it is needed to force the addition adding the opperator strSubFormula
= LEFT$(strSubFormula
, iPosI
- 1) + strOperacion
+ strRes
+ MID$(strSubFormula
, iPosD
+ 1) strSubFormula
= LEFT$(strSubFormula
, iPosI
- 1) + strRes
+ MID$(strSubFormula
, iPosD
+ 1) strSubFormula
= LEFT$(strSubFormula
, iPosI
- 1) + strASuma
+ strRes
+ MID$(strSubFormula
, iPosD
+ 1)
PRINT "strSubFormula="; strSubFormula
PRINT "strFormula="; strFormula
iOperacion = iOperacion + 1
iOperacion = iOperacion + 1
RemoverNotacionCientifica:
strNC
= LEFT$(strRes
, iNC
- 1) iNCPD
= INSTR(strNC
, ".") strNC
= LEFT$(strNC
, iNCPD
- 1) + MID$(strNC
, iNCPD
+ 1) iNCPD = iNCPD + iNC
strNC
= "." + STRING$(iNCPD
, "0") + strNC
strNC
= strNC
+ STRING$(iNCPD
- LEN(strNC
), "0") + "." strNC
= LEFT$(strNC
, iNCPD
) + "." + MID$(strNC
, iNCPD
) strRes = strNC
' Var
CErr = iError
' Var
' Initializes the string value
strExpresion = ""
iError = 0
' Returns how many variables are in memory
' Var
CuentaVar
= UBOUND(aregVariables
)
' Var
DIM strError
AS STRING ' The string with the description of the error
' Returns the text with the error description
CASE 0: strError
= "Operation succeed" CASE 1: strError
= "Special characters not allowed" CASE 2: strError
= "Variable name doesn't exist" CASE 3: strError
= "Only numeric values accepted" CASE 4: strError
= "There are uninitialized variables" CASE 5: strError
= "No expression to evaluate" CASE 6: strError
= "Parentheses pairs don't match" CASE 7: strError
= "Variable name aleady exists" CASE 8: strError
= "Cannot divide by zero" CASE 9: strError
= "Haven't executed the constructor"
DErr = strError
' Var
' Cleans the variables of the list and others. This is not strictly
' needed, but is a good programming practice to free the resources.
setExpresion ""
iError = 0
doLimpiaVar
' Gets rid of all variables in the buffer
' Var
' Gets rid of the indicated variable in the varVariable parameter
' Var
iError = 0
i = BuscaVar(varVariable)
l = 0
l = l + 1
aregX(l) = aregVariables(j)
x = x - 1
aregVariables(j) = aregX(j)
iError = 2
' Var
' Gets the string to evaluate
Expresion = strExpresion
' In this procedure are gathered the strings with the variable names
' included in the provided formula.
' This procedure will find those variables that
' fulfill the requirements of a variable name, although it will
' limit the names to 24 characters:
' MyData, Data1, Numeric_Value.
' It will reject special characters, like accented letters and ñ. If any, this procedure
' will issue an error.
' Var
iError = 0
IF SinAcentos
(strExpresion
) THEN ' Check the string to find variable names
iInicio = 1
iIniVar = 0
iFinal = 1
strCaracter
= UCASE$(MID$(strExpresion
, iInicio
, 1)) IF strCaracter
>= "A" AND strCaracter
<= "Z" AND iIniVar
= 0 THEN ' It found a letter... Now, find where it ends for the variable name.
iFinal = iInicio + 1
bFinVar = FALSE
strCaracter
= UCASE$(MID$(strExpresion
, iFinal
, 1)) IF (strCaracter
>= "A" AND strCaracter
<= "Z") OR (strCaracter
>= "0" AND strCaracter
<= "9") OR strCaracter
= "_" THEN iFinal = iFinal + 1
bFinVar = TRUE
bFinVar = TRUE
' Get the variable name
strVariable
= MID$(strExpresion
, iInicio
, iFinal
- iInicio
)
' Add the variable to the variable list
setNuevaVar strVariable
iError = 0
iInicio = iFinal
iIniVar = 0
IF (strCaracter
>= "0" AND strCaracter
<= "9") OR strCaracter
= "." THEN iIniVar = iInicio
iIniVar = 0
iInicio = iInicio + 1
' Private procedure to calculate the formula,
' includes the verification of the law of the signs (Alejandro Juarez).
' Gets rid of blank spaces to test the law of signs
strFormula
= MID$(strFormula
, 1, iPos
- 1) + MID$(strFormula
, iPos
+ 1)
' Do the modifications according the law of signs ( - by + equals - ), etcetera.
strSignos = "+++--+--"
strLey
= MID$(strSignos
, 1, 2) iPos
= INSTR(strFormula
, strLey
) strFormula
= MID$(strFormula
, 1, iPos
- 1) + "+" + MID$(strFormula
, iPos
+ 2) strFormula
= MID$(strFormula
, 1, iPos
- 1) + "-" + MID$(strFormula
, iPos
+ 2) strSignos
= MID$(strSignos
, 3) LimpiaFormula = CalculaFormula(strFormula)
' Returns the name of the variable in the indicated possition
' Var
iError = 0
NombreVar
= RTRIM$(aregVariables
(iCualVariable
).Nombre
) iError = 2
NombreVar = ""
' Gets the number at the right of the sign
' Var
iPosD = iPos + 1
bNumero = FALSE
strNumDer = ""
strCar
= MID$(strCadena
, iPosD
, 1) IF (strCar
>= "0" AND strCar
<= "9") OR strCar
= "." OR strCar
= " " OR strCar
= "-" OR strCar
= "+" THEN 'IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" THEN
IF (strCar
>= "0" AND strCar
<= "9") OR strCar
= "." THEN bNumero = TRUE
' IF strCar = "-" AND NOT bNumero THEN
iPosD = iPosD + 1
bNumero = TRUE
strNumDer = strNumDer + strCar
iPosD = iPosD + 1
strNumDer = strNumDer + strCar
iPosD = iPosD - 1
strNumDer = strNumDer + strCar
iPosD = iPosD - 1
' NumDer = VAL(LTRIM$(RTRIM$(MID$(strCadena, iPos + 1, iPosD - iPos))))
NumDer = 0
' Gets the number at the left of the sign
' Var
iPosI = iPos - 1
strCar
= MID$(strCadena
, iPosI
, 1) IF (strCar
>= "0" AND strCar
<= "9") OR strCar
= "." OR strCar
= " " OR strCar
= "-" THEN '***** CODIGO CORREGIDO ******'
iPosI = iPosI - 1
iPosI = iPosI - 1
iPosI = iPosI + 1
NumIzq = 0
' Set the string to evaluate
' Var
strExpresion = strCualExpresionEvaluar
' Ads a variable to the context.
' If the variable already exists, it will not add it
' and returns an error.
' Var
' Check if this variable name already exists
iError = 0
i = BuscaVar(strNombre)
aregX(j) = aregVariables(j)
aregVariables(j) = aregX(j)
aregVariables(i).Nombre = strNombre
aregVariables(i).Valor = ""
iError = 7
' Sets a new value (varValor) to the indicated variable name (varVariable)
' Var
iError = 0
i = BuscaVar(varVariable)
LSET aregVariables
(i
).Valor
= MKD$(varValor
)
' This function determines if the string has accents or strange characters
' Evaluate if there are characters beyond 127 in the string
iError = 0
bCorrecto = TRUE
i = 127
iError = 1
bCorrecto = FALSE
i = i + 1
SinAcentos = bCorrecto
' Substitues variable names with values in the string
' Var
strCadena
= UCASE$(strExpresion
) strMalos = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
iEncontrado = 1
iEncontrado
= INSTR(iEncontrado
, strCadena
, strVariable
) bCorrecto = TRUE
strCaracter
= MID$(strCadena
, iEncontrado
- 1, 1) bCorrecto
= (INSTR(strMalos
, strCaracter
) = 0)
strCaracter
= MID$(strCadena
, iEncontrado
+ LEN(strVariable
), 1) bCorrecto
= (INSTR(strMalos
, strCaracter
) = 0)
strCadena
= LEFT$(strCadena
, iEncontrado
- 1) + LTRIM$(STR$(Valor
(strVariable
))) + MID$(strCadena
, iEncontrado
+ LEN(strVariable
)) iEncontrado = 1
iEncontrado = iEncontrado + 1
iEncontrado = 1
SustituyeVars = strCadena
' Gets the value of the variable indicated in varVariable
' Var
iError = 0
i = BuscaVar(varVariable)
Valor
= CVD(aregVariables
(i
).Valor
) Valor = 0
iError = 4
Valor = 0
iError = 2
' Verifies if all assigned variables have values
' Var
iError = 0
bCorrecto = TRUE
iError = 4
bCorrecto = FALSE
VerificaVar = bCorrecto