Interprèteur de formule

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 234 fois - Téléchargée 31 fois

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...

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...)

A voir également

Ajouter un commentaire

Commentaires

Messages postés
117
Date d'inscription
mercredi 3 décembre 2003
Statut
Membre
Dernière intervention
11 octobre 2007
1
allez voir:

http://digilander.libero.it/foxes/mathparser/MathExpressionsParser6.htm

il s'agit d'une classe qui à mon sens est vraiment intéressante.
Messages postés
11
Date d'inscription
mardi 4 octobre 2005
Statut
Membre
Dernière intervention
6 septembre 2006

slt julien

ton sujet a beaucoup attiré mon attention car je pensais faire la meme chose, mais la complexité de la tache m'a bloqué. J'avais télécharger Mathematica 5.2 et j'ai beaucoup aimé son intérpreteur et il m'a beaucoup inspiré (en fait je te conseille de la télécharger sur réseau P2P comme eMule et Gnutella),par exemple:
-Tu traite les fonctions mathématiques et logiques avec "[" et "]" et tu oblige la première lettre en majuscule .

-Tu traite les intervalle avec <var,from,to>
-Tu utilise un arbre de résolution de formule comme l'as dis Warny (brillante idée, bravo), mais la meilleure façon de le faire est de traiter instantanément chaque bloc trouvé et de vider la mémoire allouée aux valeurs calculés (vider le buffer),mais il faut commencer avec les fonctions puis de s'attarder au variables(fonctions basiques comme +,-,*,/,^,mod,%), exemple:

<x,0,Pi><y,-Pi,Pi>((a^b)*(c*Cos(y)+d*Sin(x)+(78 mod 3))/Log(e,f))
La, tu va traiter comme suit:

1)-Tu déclare une boucle For (par exemple tu peut limiter le nombre par défaut à 8 intervalles) avec deux compteurs: x et y.
2)-dans l'arbre d'intérpretation, tu met tous les noeuds (chaque noeud contient ce qu'il y a dans les parenthèses) sans modification et sans traitement
3)-Puis tu commence par traiter les formules mathèmatiques.
4)-Ensuite les formules logiques.
5)-Et enfin les opérations de base.

Tu peux ajouter beaucoup de structures comme:
#) If. ex: If[expression,true_part,false_part]
#) {} pour les ensembles. ex:{expr1;expr2;expr3}
ou {exp1 And exp2 Or exp3}
{commande1;commande2}
{1,2,4,7,89,100,Pi}

Je te souhaite bonne chance, répond-moi ici pour savoir si tu as reçu mon commentaire.

Enfin, je suis en train un intérpreteur intégrant tou ce que je viends de dire et il sera disponible dès aue possible.

Pour plus d'infos, contactez moi sur: minouche_stingo@hotmail.com
ou: 0021262765427 (Pour les collègues marocains).

Bonn chance à tous. @+
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Salut,

Bien, comme je pense utiliser plus tard un interprètateur de formule, pour l'utiliser avec mes fonctions sur les grands nombres (peut-être le tient), je me suis lancé dans la recherche des sources sur vbfrance... Je ne prétend pas avoir tout vu, et je n'ai rien choisi non plus... j'ai recensé tous ceux que j'ai trouvé, c'est tout... De plus, j'ai pas beaucoup regardé du côté des calculatrices, ni des construteurs de courbes qui parfois possèdent un interprètateur...

Voici donc la liste (échantillon), répondant à ta première question :

http://www.vbfrance.com/code.aspx?ID=558
http://www.vbfrance.com/code.aspx?ID=559
http://www.vbfrance.com/code.aspx?ID=1048
http://www.vbfrance.com/code.aspx?ID=1297
http://www.vbfrance.com/code.aspx?ID=1973
http://www.vbfrance.com/code.aspx?ID=2209
http://www.vbfrance.com/code.aspx?ID=6666
http://www.vbfrance.com/code.aspx?ID=6955
http://www.vbfrance.com/code.aspx?ID=7713
http://www.vbfrance.com/code.aspx?ID=8009
http://www.vbfrance.com/code.aspx?ID=8418
http://www.vbfrance.com/code.aspx?ID=8495
http://www.vbfrance.com/code.aspx?ID=19166
http://www.vbfrance.com/code.aspx?ID=20949
http://www.vbfrance.com/code.aspx?ID=27437 *
http://www.vbfrance.com/code.aspx?ID=28412
http://www.vbfrance.com/code.aspx?ID=28590
http://www.vbfrance.com/code.aspx?ID=30368

(* Celui-ci, est original, à mon sens...)

=

Pour ton code, comme je l'avais déjà dit, il me semble, pour ma part bien construit. Donc pas de pb de structure... Si, maintenant je force un peu dans la critique (en toute amitié), je pense que j'essayerai de rassembler les lignes de code similaire dans une fonction. Par exemple, je vois :

Eval = Val(Left(f, InStr(1, f, "*") - 1)) * Val(Right(f, Len(f) - InStr(1, f, "*")))

avec les autres qui suivent, qui ont comme seul différence, le signe... Faire une fonction semble plus indiqué, pour la clarté...

Ensuite dans cette même partie de code, pourrait-on pas utiliser un Select case, plutôt que If ? En effet, l'expression de test InStr(1, f, "*") pourrait être mise dans une variable unique... par exemple, OPERATION = mid... , puis Select case OPERATION ... etc... C'est plus ou moins, ce que tu as fait à la fin du code...

Ensuite, j'ai pas analysé en détail... mais une chose encore me gêne, c'est de voir (en quelque sorte) 3 parties du code qui traitent les mêmes opérations, avec :

If InStr(1, f, "*") > 0 Then ... etc...

Select Case Mid(f, i, 1) .... Case "*" ....

Select Case Oper(1).Op ... Case "*" ....

Pourrait-on pas regrouper plus ou moins tout cela ?

Enfin, voilà c'est juste qlq remarques, j'ai pas regardé en détail le fonctionnement, peut-être que cela n'est pas possible...

Amicalement,
Us.
Messages postés
883
Date d'inscription
vendredi 3 novembre 2000
Statut
Membre
Dernière intervention
3 mars 2009
6
Merci pour tout... Mais vous avez pas aussi des coms sur ma source en passant ? lol...

Julien.
Messages postés
29
Date d'inscription
mercredi 1 août 2001
Statut
Membre
Dernière intervention
9 décembre 2005

Il y a plusieurs interpréteurs tout prêt, voici un exemple :

Private Sub Form_Load()
' quelques exemples
MsgBox Evaluer("21 / 321 * 3221 - 32 + 343432 / 43243.5454 / 54354 * 345 / (543 - 45 / 43 + 343)")
MsgBox Evaluer("sin(3.14159/4)")
MsgBox Evaluer("now")
MsgBox Evaluer("weekdayname(2, False, vbMonday)")
MsgBox Evaluer("""une longueur : "" & len(""azerty"")")
Unload Me
End Sub

Public Function Evaluer(Exp As String) As String
Dim X As New MSScriptControl.ScriptControl
X.Language = "VBScript"

On Error GoTo E:
Evaluer = X.Eval(Exp)

Exit Function
E:
Evaluer = "Expression invalide."
End Function

Il ne faut pas oublier de référencer 'Microsoft Script Control 1.0'.

Sinon, va voir ici :
http://vbfrance.com/code.aspx?ID=2869

bye.
Afficher les 11 commentaires

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.