Interprèteur de formule
Contenu du snippet
Je cherchais quelque chose pour pouvoir dessiner des fonctions, mon problèmes résidait dans l'interprétation de la formule (par exemple l'utilisateur devait pouvoir entrer tel quel "y=3*x^5+2*x^4-3*x^2+5" et le prog dessine) et je trouvais pas. J'ai d'abord bricolé un système ou mon prog écrivait une page html avec un vbscript dedans, le vbscript devant renvoyer comme titre du doc la réponse de la formule, et ensuite, je le récupérais grâce au controle dhtmledit, mais mon problème était alors que c'était TRES lent. Donc je me suis lancé dans une fonction permettant d'analyser une formule et de renvoyer son résultat. J'avais posé une question ici pour savoir si ca n'avait pas déjà été fait mais j'ai pas trouvé...
C'est mon premier code, soyez indulgents, mais si vous avez des idées pour aller plus vite, faites m'en part...
Bon heu j'ai été vite, y'a peu de traitement d'erreurs, fo pas lui envoyer autre chose que prévu (surtout qu'en utilisant cette technique de fonction récurente, votre espace pile souffrira vite du moindre bug...)
C'est mon premier code, soyez indulgents, mais si vous avez des idées pour aller plus vite, faites m'en part...
Source / Exemple :
Type Operator
Op As String
Prior As Integer
Location As Long
End Type
Function Eval(Formule As String) As Double
Dim f As String, i As Long, NOp As Long, buf As String
Dim Oper() As Operator, BufOp As Operator, CrntC As Long, Ordered As Boolean
Dim RStr As String, LStr As String, h As Long
f = Replace(Formule, " ", "")
f = Replace(f, "pi", "3.1415926535897932")
If InStr(1, f, "sin(") > 0 Then 'Interprétation de la fonction sinus
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Sin(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
If InStr(1, f, "cos(") > 0 Then 'Interprétation de la fonction cosinus
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
If InStr(1, f, "tan(") > 0 Then 'Interprétation de la fonction tangeante
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "tan(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
NOp = 0
For i = 1 To Len(f) 'NOp = nombre d'opérateur, cette boucle les compte
buf = Mid(f, i, 1)
If buf = "*" Or buf = "-" Or buf = "+" Or buf = "/" Or buf = "^" Or buf = "(" Then NOp = NOp + 1
Next
If NOp = 1 Then
If InStr(1, f, "*") > 0 Then
Eval = Val(Left(f, InStr(1, f, "*") - 1)) * Val(Right(f, Len(f) - InStr(1, f, "*")))
ElseIf InStr(1, f, "-") > 0 Then
Eval = Val(Left(f, InStr(1, f, "-") - 1)) - Val(Right(f, Len(f) - InStr(1, f, "-")))
ElseIf InStr(1, f, "/") > 0 Then
Eval = Val(Left(f, InStr(1, f, "/") - 1)) / Val(Right(f, Len(f) - InStr(1, f, "/")))
ElseIf InStr(1, f, "+") > 0 Then
Eval = Val(Left(f, InStr(1, f, "+") - 1)) + Val(Right(f, Len(f) - InStr(1, f, "+")))
ElseIf InStr(1, f, "(") > 0 Then
Eval = Val(Mid(f, 2))
ElseIf InStr(1, f, "^") > 0 Then
Eval = Val(Left(f, InStr(1, f, "^") - 1)) ^ Val(Right(f, Len(f) - InStr(1, f, "^")))
End If
Exit Function
ElseIf NOp = 0 Then
Eval = Val(Formule)
Exit Function
Else
ReDim Oper(NOp)
CrntC = 1
For i = 1 To Len(f)
Select Case Mid(f, i, 1)
Case "("
BufOp.Location = i
BufOp.Op = "("
BufOp.Prior = 0
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "^"
BufOp.Location = i
BufOp.Op = "^"
BufOp.Prior = 1
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "/"
BufOp.Location = i
BufOp.Op = "/"
BufOp.Prior = 2
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "*"
BufOp.Location = i
BufOp.Op = "*"
BufOp.Prior = 3
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "+"
BufOp.Location = i
BufOp.Op = "+"
BufOp.Prior = 4
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "-"
BufOp.Location = i
BufOp.Op = "-"
BufOp.Prior = 4
Oper(CrntC) = BufOp
CrntC = CrntC + 1
End Select
Next
'TriBulle()
While Ordered = False
Ordered = True
For i = 1 To NOp - 1
If Oper(i).Prior > Oper(i + 1).Prior Then
BufOp = Oper(i)
Oper(i) = Oper(i + 1)
Oper(i + 1) = BufOp
Ordered = False
End If
Next
Wend
'Localisation du premier bloc à traiter
If Oper(1).Op = "(" Then
h = 1
i = Oper(1).Location
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - Oper(1).Location
Eval = Eval(Left(f, Oper(1).Location - 1) & Str(Eval(Mid(f, Oper(1).Location + 1, i - 1))) & Right(f, Len(f) - (i + Oper(1).Location)))
Else
i = Oper(1).Location - 1
While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i > 1
i = i - 1
Wend
LStr = Mid(f, i, Oper(1).Location - i)
i = Oper(1).Location + 1
While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i < Len(f)
i = i + 1
Wend
RStr = Mid(f, Oper(1).Location + 1, i - Oper(1).Location - 1)
Select Case Oper(1).Op
Case "*"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) * Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "/"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) / Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "+"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) + Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "-"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) - Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "^"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) ^ Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
End Select
End If
End If
End Function
Public Function Str2(Value As Double) As String 'pour éviter les . qui deviennent , etc
Str2 = Replace(Format(Value, "#0.##########################################"), ",", ".")
End Function
Conclusion :
Bon heu j'ai été vite, y'a peu de traitement d'erreurs, fo pas lui envoyer autre chose que prévu (surtout qu'en utilisant cette technique de fonction récurente, votre espace pile souffrira vite du moindre bug...)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.