Evaluation récursive d'une expression sous forme de chaîne

Télécharger le projet
Commenter

Description

Calcul d'une expression sous forme de texte.
Je vous présente la fonction a_EvalString permettant de calculer des expressions de la plus simple à la plus compliquée. contenant les fonctions mathématiques de base. La fonction est prévue pour traîter les erreurs. La deuxième fonction sert à traîter les parenthèses. La troisième à vérifier les opérateurs.

La précédence des opératuers est totalement respectée.

Exemples d'évaluations de chaînes :
cos(45)^2+sin(45)^2 donne 1 (évident)
1+(6*(5/2)+8)*3 donne 70
exp(1) donne 2.718281828...
2*pi*4.5^2 donne 127.23..

N'hésitez pas à donner vos commentaires. J'espère que cette source pourra vous être utile.
Merci.

Source / Exemple : 


Function a_EvalString(ByVal a$)
On Error GoTo Errh_a_Evalstring
Dim p As Integer, p2 As Integer, par As Integer, v2 As Single
Dim fct$, allfct$, i As Integer, found
a$ = LCase$(a$) 'Pour faciliter la recherche des fontions.
If a$ = "" Then
    a_EvalString = "ERREUR Vierge"
    Exit Function
End If
p = InStr(a$, "erreur")
If p <> 0 Then
    a_EvalString = Mid$(a$, p)
    Exit Function
End If
allfct$ = "int,abs,atn,cos,exp,fix,log,rnd,sgn,sin,sqr,tan"
For i = 1 To Len(allfct$) Step 4
    fct$ = Mid$(allfct$, i, 3)
    p = InStr(a$, fct$ + "(")
    If p <> 0 Then
        p2 = a_GetPosPar(a$, p + Len(fct$))
        If p2 = -1 Then
            a_EvalString = "ERREUR Par sur " + fct$
            Exit Function
        End If
        If Not A_verifop(Trim$(Left$(a$, p - 1)), 1) Or Not A_verifop(Mid$(a$, p2 + 1), 2) Then
            a_EvalString = "ERREUR opérateur"
        Else
            
            Select Case fct$
            Case "int"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Int(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "abs"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Abs(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "atn"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Atn(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "cos"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Cos(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "exp"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Exp(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "fix"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Fix(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "log"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Log(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "rnd"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Rnd(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "sgn"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Sgn(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "sin"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Sin(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "sqr"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Sqr(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            Case "tan"
                a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(Tan(a_EvalString(Mid$(a$, p + 1 + Len(fct$), p2 - p - 1 - Len(fct$))))) + Mid$(a$, p2 + 1))
            End Select
        End If
        Exit Function
    End If
Next i

p = InStr(a$, "(")
If p <> 0 Then
    p2 = a_GetPosPar(a$, p)
    If p2 = -1 Then
        a_EvalString = "ERREUR Parenthèses"
        Exit Function
    End If
    If Not A_verifop(Trim$(Left$(a$, p - 1)), 1) Or Not A_verifop(Mid$(a$, p2 + 1), 2) Then
        a_EvalString = "ERREUR opérateur"
    Else
        a_EvalString = a_EvalString(Left$(a$, p - 1) + Format$(a_EvalString(Mid$(a$, p + 1, p2 - p - 1))) + Mid$(a$, p2 + 1))
    End If
    Exit Function
End If
p = InStr(a$, "+")
If p <> 0 Then
    a_EvalString = a_EvalString(Left$(a$, p - 1)) + a_EvalString(Mid$(a$, p + 1))
    Exit Function
End If
p = InStr(2, a$, "-")
If p <> 0 Then
    allfct$ = "e-,*-,/-,^-"
    found = False
    For i = 1 To Len(allfct$) Step 3
        p2 = InStr(a$, Mid$(allfct$, i, 2))
        If p2 = p - 1 And p2 <> 0 Then
            found = True
        End If
    Next i
    If Not found Then
        If p > 1 Then
            a_EvalString = a_EvalString(Left$(a$, p - 1)) - a_EvalString(Mid$(a$, p + 1))
            Exit Function
        Else
            Stop
            'a_EvalString = -a_EvalString(Mid$(a$, p + 1))
            'Exit Function
        End If
    End If
End If
p = InStr(a$, "*")
If p <> 0 Then
    a_EvalString = a_EvalString(Left$(a$, p - 1)) * a_EvalString(Mid$(a$, p + 1))
    Exit Function
End If
p = InStr(a$, "\")
If p <> 0 Then
    a_EvalString = a_EvalString(Left$(a$, p - 1)) \ a_EvalString(Mid$(a$, p + 1))
    Exit Function
End If
p = InStr(a$, "^")
If p <> 0 Then
    a_EvalString = a_EvalString(Left$(a$, p - 1)) ^ a_EvalString(Mid$(a$, p + 1))
    Exit Function
End If

p = InStr(a$, "/")
If p <> 0 Then
    v2 = a_EvalString(Mid$(a$, p + 1))
    If v2 <> 0 Then
        a_EvalString = a_EvalString(Left$(a$, p - 1)) / v2
    Else
        a_EvalString = "ERREUR division par 0"
    End If
    Exit Function
End If

If a$ <> "" Then
    If a$ = "pi" Then
        a_EvalString = 4 * Atn(1)
    ElseIf a$ = "-pi" Then
        a_EvalString = -4 * Atn(1)
    ElseIf a$ = "e" Then
        a_EvalString = "2.7182818284590452353602874713527" 'exp(1)
    ElseIf a$ = "-e" Then
        a_EvalString = "-2.7182818284590452353602874713527"
    Else
        a_EvalString = CDbl(a$) 'Val(a$)
    End If
Else
    a_EvalString = "ERREUR Vierge"
End If
Exit Function
Errh_a_Evalstring:
    a_EvalString = "ERREUR"
End Function
Function a_GetPosPar(a$, p2)
Dim p As Integer, par As Integer
    
    p = p2
    par = 1
    Do
        p = p + 1
        Select Case Mid$(a$, p, 1)
        Case "(": par = par + 1
        Case ")": par = par - 1
        End Select
    Loop Until par = 0 Or p > Len(a$)
    If par <> 0 Then
        a_GetPosPar = -1
    Else
        a_GetPosPar = p
    End If
End Function
Function A_verifop(a$, flag)
Dim ok As Integer
a$ = Trim$(a$)
If a$ = "" Then
    A_verifop = True
    Exit Function
End If
ok = False
Select Case flag
Case 2
    Select Case Left$(a$, 1)
    Case "+", "-", "*", "/", "^", ")"
        ok = True
    End Select
Case 1
    Select Case Right$(a$, 1)
    Case "+", "-", "*", "/", "^", "("
        ok = True
    End Select
End Select
A_verifop = ok
If ok = False Then Stop
End Function

Conclusion :


Je remercie EbartSoft qui a mis le doigt sur une erreur, corrigée depuis.

Pour une representation de fonction cartésienne ou polaire, allez voir la source : 9770
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (olivier6530)