Code intéressant, mais travaillant en 32 bit et avec quelque soucis (par rapport à mon code de calcul littéral de ma calculatrice)
Par contre, le code est relativement simple. Donc j'ai modifié pour pouvoir l'utiliser.
- Ajout du support 64bits
- Nettoyage du code (j'ai supprimé des procédures inutiles)
- Ajout de la fonction factorielle " ! "
- Ajout de la fonction %
- Ajout des fonctions = > < >= <= <>
- Ajout d'une erreur pour les calculs impossible, exemple : Sqr(-1) log(-10) 0.8! etc...
- Ajout du mode Degrés ou Radian
- Ajout du support de l'unicode
Code : Tout sélectionner
; Operanten-Codes
Enumeration -1
#OP_UNKNOWN
#OP_NONE
#OP_PLUS
#OP_MINUS
#OP_MULT
#OP_DIV
#OP_POT
#OP_FACT
#OP_PERCENT
#OP_EQUAL
#OP_SUP
#OP_INF
#OP_SUPEQUAL
#OP_INFEQUAL
#OP_NOTEQUAL
#OP_FUNC
EndEnumeration
; Funktions-Codes
Enumeration 1
#FUNC_SQR
#FUNC_SIN
#FUNC_ASIN
#FUNC_COS
#FUNC_ACOS
#FUNC_TAN
#FUNC_ATAN
#FUNC_INT
#FUNC_ABS
#FUNC_LOG10
#FUNC_LOG
EndEnumeration
; Constant
#CONST_PI = "3.1415926535897932" ; PI
#CONST_E = "2.7182818284590451" ; Eulersche Zahl
; Mode
#CALC_MODE_RAD = 1
#CALC_MODE_DEG = 2
; Error-Codes
#CALC_ERR_NONE = 0 ; No error
#CALC_ERR_SYNTAX = 1 ; Syntax error
#CALC_ERR_DIVNULL = 2 ; Division / 0
#CALC_ERR_OPNOTFOUND = 3 ; Operand not found
#CALC_ERR_FUNCNOTFOUND = 4 ; Function not found
#CALC_ERR_WRONGINPUT = 5 ; Wrong input parameter in function
#PRIORITY_STEP = 6 ; entspricht der hchsten Priorittsstufe der Operanten
#MAX_TREENODES = 256 ; Maximale Anzahl an SyntaxBaum-Knoten
#OPERAND = 1
#VALUE = 2
Structure SyntaxTreeNode
*parent.SyntaxTreeNode
*child.SyntaxTreeNode[2]
operand.i
prior.i
Value.d
EndStructure
Structure SyntaxTree
*root.SyntaxTreeNode
node.SyntaxTreeNode[#MAX_TREENODES]
remark$ ; frei verwendbar
EndStructure
;{ Declarations
Declare.i GetCalculationError()
Declare SetRadCalculatation()
Declare SetDegCalculatation()
Declare.d CalculateD(expression$)
Declare.f CalculateF(expression$)
Declare.q CalculateQ(expression$)
Declare.i CalculateI(expression$)
Declare.l CalculateL(expression$)
Declare.q CalculateSyntaxTreeL(*tree.SyntaxTree)
Declare.d CalculateSyntaxTreeF(*tree.SyntaxTree)
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$)
Declare.d Calc_GetNodeValue(*node.SyntaxTreeNode)
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.i, *nodeInsert.SyntaxTreeNode)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Declare.s Calc_GetContent(expression.s, type.i, *pos.Integer)
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode)
;}
Global Radian.i
Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode)
Shared priorMod.q
While Left(operand$, 1) = ")"
operand$ = Mid(operand$, 2, Len(operand$) - 1)
priorMod - #PRIORITY_STEP
Wend
While Right(operand$, 1) = "("
operand$ = Left(operand$, Len(operand$) - 1)
changePrior.q + #PRIORITY_STEP
Wend
Select operand$
Case "+"
*node\operand = #OP_PLUS
*node\prior = priorMod + 1
Case "-"
*node\operand = #OP_MINUS
*node\prior = priorMod + 1
Case "*"
*node\operand = #OP_MULT
*node\prior = priorMod + 2
Case "/"
*node\operand = #OP_DIV
*node\prior = priorMod + 2
Case "^"
*node\operand = #OP_POT
*node\prior = priorMod + 3
Case "!"
*node\operand = #OP_FACT
*node\prior = priorMod + 4
Case "%"
*node\operand = #OP_PERCENT
*node\prior = priorMod + 4
Case "="
*node\operand = #OP_EQUAL
*node\prior = priorMod + 5
Case ">"
*node\operand = #OP_SUP
*node\prior = priorMod + 5
Case "<"
*node\operand = #OP_INF
*node\prior = priorMod + 5
Case ">="
*node\operand = #OP_SUPEQUAL
*node\prior = priorMod + 5
Case "<="
*node\operand = #OP_INFEQUAL
*node\prior = priorMod + 5
Case "<>"
*node\operand = #OP_NOTEQUAL
*node\prior = priorMod + 5
Case "~"
*node\operand = #OP_FUNC
; ACHTUNG: Funktionen mssen IMMMER die hchste Prioritt besitzen
*node\prior = priorMod + 6
Default
*node\operand = #OP_UNKNOWN
EndSelect
priorMod + changePrior
EndProcedure
Procedure.s Calc_GetContent(expression.s, type.i, *pos.Integer)
Memoire = *pos\i
Index = *pos\i + 1
If type = #VALUE
; (-x) Ausrdrcke zulassen
Char.i = Asc(Mid(expression, Index, 1))
If Char = '-'
; Debug Chr(Char)
Index + 1
Char.i = Asc(Mid(expression, Index, 1))
EndIf
; ) + - * / ^ ~ ! % \0
; Ascii-Wert eines neuen Operators hier mit einfgen
; Debug Chr(Char)
While (Char < 'a' Or Char > 'z') And Char <> ')' And Char <> '*' And Char <> '+' And Char <> '-' And Char <> '/' And Char <> '^' And Char <> '!' And Char <> '%' And Char <> '~' And Char <> '>' And Char <> '<' And Char <> '=' And Char <> 0
Index + 1
Char.i = Asc(Mid(expression, Index, 1))
; Debug Chr(Char)
Wend
Else
; 0-9 .
Char.i = Asc(Mid(expression, Index, 1))
; Debug Chr(Char)
While (Char < '0' Or Char > '9') And Char <> '.' And Char <> 0
Index + 1
Char.i = Asc(Mid(expression, Index, 1))
; Debug Chr(Char)
Wend
; (-x) Ausrdrcke zulassen
Char1.i = Asc(Mid(expression, Index - 1, 1))
Char2.i = Asc(Mid(expression, Index - 2, 1))
If Char1 = '-' And (Char2 = '(' Or Char2 = '*' Or Char2 = '+' Or Char2 = '/' Or Char2 = '^' Or Char2 = '-' Or Char2 = '>' Or Char2 = '<' Or Char2 = '=' Or Char2 = '!' Or Char2 = '%') ; '(-' '*-' '+-' '/-' '^-' '--'
Index - 1
EndIf
EndIf
Index - 1
a_RET$ = Mid(expression, *pos\i + 1, Index - *pos\i)
If Char
*pos\i = Index
Else
*pos\i = -1
EndIf
; Debug ""
; Debug *pos\i
; Debug a_RET$
; Debug "-------------------"
; *pos\i = Memoire
;
; *pointer.Byte = @expression + *pos\i
;
; If type = #VALUE
; ; (-x) Ausrdrcke zulassen
; If PeekB(*pointer) = '-'
; Debug Chr(PeekB(*pointer))
; *pointer + 1
; EndIf
;
; ; ) + - * / ^ ~ ! % \0
; ; Ascii-Wert eines neuen Operators hier mit einfgen
; Debug Chr(PeekB(*pointer))
; While (*pointer\b < 'a' Or *pointer\b > 'z') And *pointer\b <> ')' And *pointer\b <> '*' And *pointer\b <> '+' And *pointer\b <> '-' And *pointer\b <> '/' And *pointer\b <> '^' And *pointer\b <> '!' And *pointer\b <> '%' And *pointer\b <> '~' And *pointer\b <> 0
; *pointer + 1
; Debug Chr(PeekB(*pointer))
; Wend
; Else
; ; 0-9 .
; Debug Chr(PeekB(*pointer))
; While (*pointer\b < '0' Or *pointer\b > '9') And *pointer\b <> '.' And *pointer\b <> 0
; *pointer + 1
; Debug Chr(PeekB(*pointer))
; Wend
; ; (-x) Ausrdrcke zulassen
; If PeekB(*pointer - 1) = '-' And (PeekB(*pointer - 2) = '(' Or PeekB(*pointer - 2) = '*' Or PeekB(*pointer - 2) = '+' Or PeekB(*pointer - 2) = '/' Or PeekB(*pointer - 2) = '^' Or PeekB(*pointer - 2) = '-') ; '(-' '*-' '+-' '/-' '^-' '--'
; *pointer - 1
; EndIf
; EndIf
;
; a_RET$ = PeekS(@expression + *pos\i,(*pointer - @expression) - *pos\i)
;
; If *pointer\b
; *pos\i = *pointer - @expression
; Else
; *pos\i = -1
; EndIf
;
; Debug ""
; Debug *pos\i
; Debug a_RET$
; Debug "________________"
ProcedureReturn a_RET$
EndProcedure
Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Protected child.i
If *nodeTarget\parent
If *nodeTarget\parent\child[0] = *nodeTarget
child = 0
ElseIf *nodeTarget\parent\child[1] = *nodeTarget
child = 1
EndIf
*nodeTarget\parent\child[child] = *nodeInsert
*nodeInsert\parent = *nodeTarget\parent
EndIf
*nodeTarget\parent = *nodeInsert
*nodeInsert\child[0] = *nodeTarget
EndProcedure
Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.i, *nodeInsert.SyntaxTreeNode)
If *nodeTarget\child[child]
*nodeChild.SyntaxTreeNode = *nodeTarget\child[child]
*nodeChild\parent = *nodeInsert
*nodeInsert\child[0] = *nodeTarget\child[child]
EndIf
*nodeTarget\child[child] = *nodeInsert
*nodeInsert\parent = *nodeTarget
EndProcedure
Procedure.d Calc_GetNodeValue(*node.SyntaxTreeNode)
Shared calculationErrorOccured.b
Result.d
If *node
If *node\operand
valueOne.d = Calc_GetNodeValue(*node\child[0])
valueTwo.d = Calc_GetNodeValue(*node\child[1])
Select *node\operand
Case #OP_PLUS
Result = valueOne + valueTwo
Case #OP_MINUS
Result = valueOne - valueTwo
Case #OP_MULT
Result = valueOne * valueTwo
Case #OP_DIV
Result = valueOne / valueTwo
If valueTwo = 0 And calculationErrorOccured = 0
calculationErrorOccured = #CALC_ERR_DIVNULL
EndIf
Case #OP_POT
Result = Pow(valueOne, valueTwo)
Case #OP_FACT
If IntQ(valueOne) <> valueOne Or valueOne <= 0
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = 1
For x = 2 To valueOne
Result * x
Next
Case #OP_PERCENT
Result = valueOne / 100
Case #OP_EQUAL
If valueOne = valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_SUP
If valueOne > valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_INF
If valueOne < valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_SUPEQUAL
If valueOne => valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_INFEQUAL
If valueOne <= valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_NOTEQUAL
If valueOne <> valueTwo
Result = 1
Else
Result = 0
EndIf
Case #OP_FUNC
Select valueOne ; steht fr den Funktionstyp
Case #FUNC_SQR
If valueTwo <= 0
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = Sqr(valueTwo)
Case #FUNC_SIN
If Radian = 0
valueTwo * #PI / 180
EndIf
Result = Sin(valueTwo)
Case #FUNC_ASIN
If valueTwo < - 1 Or valueTwo > 1
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = ASin(valueTwo)
If Radian = 0
Result * 180 / #PI
EndIf
Case #FUNC_COS
If Radian = 0
valueTwo * #PI / 180
EndIf
Result = Cos(valueTwo)
Case #FUNC_ACOS
If valueTwo < - 1 Or valueTwo > 1
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = ACos(valueTwo)
If Radian = 0
Result * 180 / #PI
EndIf
Case #FUNC_TAN
If Radian = 0
valueTwo * #PI / 180
EndIf
Result = Tan(valueTwo)
If Radian = 0
Result * 180 / #PI
EndIf
Case #FUNC_ATAN
Result = ATan(valueTwo)
If Radian = 0
Result * 180 / #PI
EndIf
Case #FUNC_INT
Result = IntQ(valueTwo)
Case #FUNC_ABS
Result = Abs(valueTwo)
Case #FUNC_LOG10
If valueTwo < 0
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = Log10(valueTwo)
Case #FUNC_LOG
If valueTwo < 0
calculationErrorOccured = #CALC_ERR_WRONGINPUT
EndIf
Result = Log(valueTwo)
Default
calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND
EndSelect
Case #OP_UNKNOWN
calculationErrorOccured = #CALC_ERR_OPNOTFOUND
EndSelect
ProcedureReturn Result
Else
ProcedureReturn *node\Value
EndIf
Else
calculationErrorOccured = 1
EndIf
EndProcedure
Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$)
Shared priorMod.q, functionCalculationEnabled.b, constantCalculationEnabled.b
priorMod = 0
nodeCount.i = 0
Position.i = 0
*nodeLastValue.SyntaxTreeNode
*nodeCurrentValue.SyntaxTreeNode
*nodeLastOperand.SyntaxTreeNode
*nodeCurrentOperand.SyntaxTreeNode
expression$ = LCase(ReplaceString(expression$, " ", ""))
While Left(expression$, 1) = "("
expression$ = Mid(expression$, 2, Len(expression$) - 1)
priorMod + #PRIORITY_STEP
Wend
While Right(expression$, 1) = ")"
expression$ = Left(expression$, Len(expression$) - 1)
Wend
expression$ = ReplaceString(expression$, "sqr", Str(#FUNC_SQR) + "~")
expression$ = ReplaceString(expression$, "asin", Str(#FUNC_ASIN) + "~")
expression$ = ReplaceString(expression$, "sin", Str(#FUNC_SIN) + "~")
expression$ = ReplaceString(expression$, "acos", Str(#FUNC_ACOS) + "~")
expression$ = ReplaceString(expression$, "cos", Str(#FUNC_COS) + "~")
expression$ = ReplaceString(expression$, "atan", Str(#FUNC_ATAN) + "~")
expression$ = ReplaceString(expression$, "tan", Str(#FUNC_TAN) + "~")
expression$ = ReplaceString(expression$, "int", Str(#FUNC_INT) + "~")
expression$ = ReplaceString(expression$, "abs", Str(#FUNC_ABS) + "~")
expression$ = ReplaceString(expression$, "log", Str(#FUNC_LOG10) + "~")
expression$ = ReplaceString(expression$, "ln", Str(#FUNC_LOG) + "~")
expression$ = ReplaceString(expression$, "!", "!0")
expression$ = ReplaceString(expression$, "%", "%0")
expression$ = ReplaceString(expression$, "pi", #CONST_PI)
expression$ = ReplaceString(expression$, "e^", #CONST_E + "^")
Repeat
nodeCount + 1
If nodeCount & %1 = 1
node$ = Calc_GetContent(expression$, #VALUE, @Position)
*tree\node[nodeCount]\Value = ValD(node$)
*nodeCurrentValue = *tree\node[nodeCount]
; Debug node$
If nodeCount > 1
Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue)
EndIf
*nodeLastValue = *nodeCurrentValue
Else ; Operator
node$ = Calc_GetContent(expression$, #OPERAND, @Position)
Calc_SetOperand(node$, *tree\node[nodeCount])
*nodeCurrentOperand = *tree\node[nodeCount]
; Debug node$ + " :: " + Str(*nodeCurrentOperand\prior)
If *nodeLastOperand
If *nodeCurrentOperand\prior > *nodeLastOperand\prior
Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand)
ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior
Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand)
Else
*node.SyntaxTreeNode = *nodeLastOperand
While *node\parent And *node\prior > *nodeCurrentOperand\prior
*node = *node\parent
Wend
If *node\prior = *nodeCurrentOperand\prior
Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
ElseIf *node\prior < *nodeCurrentOperand\prior
Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand)
Else
Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
EndIf
EndIf
Else
Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand)
EndIf
*nodeLastOperand = *nodeCurrentOperand
EndIf
Until Position = -1
If *nodeLastOperand
While *nodeLastOperand\parent
*nodeLastOperand = *nodeLastOperand\parent
Wend
*tree\root = *nodeLastOperand
ElseIf nodeCount = 1
*tree\root = *nodeLastValue
Else
*tree\root = 0
EndIf
EndProcedure
Procedure.d CalculateSyntaxTreeF(*tree.SyntaxTree)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
If *tree\root
Result.d = Calc_GetNodeValue(*tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
Result.d = 0 / Result
EndIf
ProcedureReturn Result
EndProcedure
Procedure.q CalculateSyntaxTreeL(*tree.SyntaxTree)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
If *tree\root
Result.q = Calc_GetNodeValue(*tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure SetCalculatationMode(Mode.i)
Select Mode
Case #CALC_MODE_RAD
Radian = 1
Case #CALC_MODE_DEG
Radian = 0
EndSelect
EndProcedure
Procedure.l CalculateL(expression$)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
tree.SyntaxTree
CreateSyntaxTree(@tree, expression$)
If tree\root
Result.l = Calc_GetNodeValue(tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i CalculateI(expression$)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
tree.SyntaxTree
CreateSyntaxTree(@tree, expression$)
If tree\root
Result.i = Calc_GetNodeValue(tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure.q CalculateQ(expression$)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
tree.SyntaxTree
CreateSyntaxTree(@tree, expression$)
If tree\root
Result.q = Calc_GetNodeValue(tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
EndIf
ProcedureReturn Result
EndProcedure
Procedure.f CalculateF(expression$)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
tree.SyntaxTree
CreateSyntaxTree(tree, expression$)
If tree\root
Result.f = Calc_GetNodeValue(tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
Result.f = 0 / Result
EndIf
ProcedureReturn Result
EndProcedure
Procedure.d CalculateD(expression$)
Shared calculationErrorOccured.b
calculationErrorOccured = 0
tree.SyntaxTree
CreateSyntaxTree(tree, expression$)
If tree\root
Result.d = Calc_GetNodeValue(tree\root)
Else
; Fehler auslsen
calculationErrorOccured = 1
Result.d = 0 / Result
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i GetCalculationError()
Shared calculationErrorOccured.b
ProcedureReturn calculationErrorOccured
EndProcedure
SetCalculatationMode(#CALC_MODE_DEG)
Debug CalculateD("acos(0)")
Debug GetCalculationError()
