Bon Direct le but de la source :
Cette analyseur n'est pas optimisé pour une UNIQUE analyse d'équation, il est avant tout destiné au graphe.
Why ?
Pour la simple et bonne raison qu'il modifie l'équation entrée AVANT un calcul.
Au lieu d'analyser l'équation BRUTE, il la transforme de façon à ce que la methode de calcul de l'equation soit identique pour toute les valeurs de X
Un exemple :
L'équation "3*(X+1)" a des priorités. Un analyseur classique s'amuserait à décortiquer cette chaine pour chaque valeur de X que l'on insère.
L'algo permet d'effectuer une seule fois les instructions qui doivent être effectuées.
Dans cet exemple, l'algo n'as pas besoin de 'comprendre' 10 000 fois que l'addition est prioritaire à la multiplication. D'ou l'idée de fixer definitivement la suite de calcul a faire...
Donc cet algo étudie la chaine, la cisaille en élément (opérateur, nombre, fonction : cosinus sinus etc ...) et priorise UNE FOIS POUR TOUTE les priorités de calcul.
La chaine d'exemple deviendrait donc la liste d'element suivant :
"5", "1", "+", "3", "*"
Et Voila, l'Interpretation est faite, c'est la premiere etape pour calculer l'equation avec uen valeur de X (Vous-en faite pas, le mode d'emploi est en commentaire dans la source )
2ème étape : On fournit une valeur pour X
Une fois que l'interpratation est fini, lstElement contient les element TRIES de la chaine. A chaque calcul our une valeur de X, on effectue une copie de cette liste dans RAM.Calcul
Voici le fonctionnement du code pour le calcul de l'equation :
Le code lit les élément de gauche à droite. Des qu'un certain élément i est un opéateur, il traite les élément i-1 et i-2 suivant le type d'operateur bien sur, puis enregistre le resultat l'element i(donc rempalce l'operateur). Dès qu'il rencontre une fonction, il traite l'element i-1 et enregistre dans l'element i
Notre chaine, avec pour valeur de X, 5 deviendrait donc succesivement :
0)
"5", "1", "+", "3", "*" 'Chaine RAM d'origin
1)
"5", "1", "6", "3", "*" 'Action du "+" remplacé par le résultat
2)
"5", "1", "6", "3", "18" 'Action du "*" remplacé par le résultat
La lecture de gauche a droite est terminé, le résultat se trouve dans l'élément de droite. Soit pour, X=5, 18 !
Bon voila en gros le principe... Si vous ne comprenez pas aller sur le chat je serais la normalement (PV moi je repondrai en temps reel ou quand je reviens)
J'espere que toute cette exlication n'aura pas ete inutile.
Je vous invite maintenant à faire autant d'effort lors de vos dépot de sources. :) Sur ce Bonne prog !!!
ZeroCool
P.S : Pour les fainéants y'a un zip aussi...
Source / Exemple :
'**********************************************************
'*//// \\\\*
'*/// Auteur : ZeroCool \\\*
'*// mail : zyro_c00@yahoo.fr \\*
'*/ \*
'*\ --- 2002 --- Copyright --- /*
'*\\ //*
'*\\\ ///*
'*\\\\ ////*
'**********************************************************
'[MODE D'emploi]
'-[I]-
'
'Avant de calculer une chaine, il faut interpreter la chaine.
'Pour ce faire, vous devz utiliser la fonction suivante comme ceci :
'
' Reponse = Interpreter(Votre_Equation, Le_Caractere_Variable)
'
' Votre_Equation doit etre une chaine de caractere.
' Le_Caractere_Variable doit être un caractère ( 'x' en general )
'
'Cette fonction renvoie la valeur True si la chaine est conforme à une équation,
'elle renvoie false dans le cas contraire ou par echec d'interpretation
'
'
'-[II]-
'
'Une fois interprete , le calcul peut etre effectue autant de fois que vous voulez.
'Il suffit juste d'executer la fonction suivante avec pour argument :
' 1) le caractere identifiant la variable aleatoire ( 'x' en general )
' 2) La valeur qu'il lui est attribuée lors de ce calcul
'
'Exemple : Y = Calcul( "x", 0) 'Resultat du calcul de l'equation pour x =0
'
' /!\ ATTENTION ! /!\
'Lors d'un calcul, vous devrez ensuite toujours verifier
'la valeur de la variable suivante : RetourCalcul
'
'--> Si RetourCalcul = 0, cela signifie que le calcul s'est effectué sans aucun probleme
'--> Si RetourCalcul > 0, cela signifie, suivant la valeur exacte, que le calcul a échoué ( /0 )
'
'
'D'emploi
'CODE :
'Variable Externe :
Dim RetourCalcul As Byte
'Variables internes pour le traitement syntaxique de la formule
Private Type CalculChaine
Calcul() As String
Chaine() As Integer
End Type
Private lstElement() As String
Private RAM As CalculChaine
Private lstOperateur()
'Variable de dialogue inter-procedures
Private Pos As Integer
Private Profondeur As Integer
Private Nombre As Byte
Function Interpreter(Equa As String, Car As String) As Byte
Interpreter = False
Dim i As Integer, Var As Integer
If Left(Equa, 1) = "-" Then Equa = "0" & Equa
Equa = Replace(Equa, "(-", "(0-")
Var = 0
i = 0
While i < Len(Equa)
i = i + 1
If Mid$(Equa, i, 1) = "(" Then Var = Var + 1
If Mid$(Equa, i, 1) = ")" Then Var = Var - 1
If Var < 0 Then GoTo TropParent
If Var = 32767 Then
MsgBox "Desolé ,il y a trop de profondeur de parentheses"
Exit Function
End If
Wend
If Var Then
TropParent:
MsgBox "Desolé , Vos parenthèses sont invalides"
Exit Function
End If
Equa = LCase(Equa)
'Fonction avancées
Equa = Replace(Equa, "sqr(", "Q")
Equa = Replace(Equa, "cos(", "C")
Equa = Replace(Equa, "sin(", "S")
Equa = Replace(Equa, "tan(", "T")
Equa = Replace(Equa, "soc(", "O")
Equa = Replace(Equa, "nis(", "I")
Equa = Replace(Equa, "nat(", "N")
Equa = Replace(Equa, "log(", "G")
Equa = Replace(Equa, "ln(", "L")
Equa = Replace(Equa, "abs(", "A")
Equa = Replace(Equa, "exp(", "E")
Equa = Replace(Equa, "mod(", "D")
Equa = Replace(Equa, "int(", "B")
ReDim lstElement(Len(Equa))
ReDim lstOperateur(2, Len(Equa))
Pos = 0: Profondeur = 0: Nombre = 0
For i = 1 To Len(Equa)
Correction:
Select Case Mid(Equa, i, 1)
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", ",", ".", Car
If Nombre = 2 Then
Equa = Left$(Equa, i - 1) & "*" & Right$(Equa, Len(Equa) - i + 1)
GoTo Correction
End If
If Nombre = 0 Then Pos = Pos + 1
lstElement(Pos) = lstElement(Pos) & Mid(Equa, i, 1)
Nombre = True
Case "^"
Call Affecter(0, Equa, "^")
Case "*", "/"
Call Affecter(1, Equa, Mid(Equa, i, 1))
Case "\"
Call Affecter(2, Equa, "\")
Case "D"
Call Affecter(3, Equa, "D")
Case "+", "-"
Call Affecter(4, Equa, Mid(Equa, i, 1))
Case "C", "S", "T", "O", "I", "N", "G", "L", "A", "Q", "E", "B"
If Nombre > 0 Then
Equa = Left$(Equa, i - 1) & "*" & Right$(Equa, Len(Equa) - i + 1)
GoTo Correction
End If
Profondeur = Profondeur + 1
Call Affecter(5, Equa, Mid(Equa, i, 1))
Case "("
If Nombre > 0 Then
Equa = Left$(Equa, i - 1) & "*" & Right$(Equa, Len(Equa) - i + 1)
GoTo Correction
End If
Nombre = False
Profondeur = Profondeur + 1
Case ")"
Nombre = 2
Profondeur = Profondeur - 1
Var = 0
Do Until Val(lstOperateur(1, lstOperateur(0, 0))) <= Profondeur
Var = Var + 1
lstElement(Pos + Var) = lstOperateur(0, lstOperateur(0, 0))
lstOperateur(0, 0) = lstOperateur(0, 0) - 1
Loop
Pos = Pos + Var
End Select
Next i
For i = lstOperateur(0, 0) To 1 Step -1
Pos = Pos + 1
lstElement(Pos) = lstOperateur(0, i)
Next i
lstElement(0) = Pos
ReDim Preserve lstElement(Pos)
ReDim RAM.Calcul(Pos)
ReDim RAM.Chaine(Pos)
'POUR VOIR L'AGENCEMENT DE L'ALGO DANS LA LISTE
' Dim Total
' For i = 1 To Pos
' Total = Total & " " & lstElement(i)
' Next
' MsgBox Total
Interpreter = True
End Function
Sub Affecter(Priorite As Byte, Formule As String, Car As String)
Nombre = False
Do Until lstOperateur(0, 0) = 0
If lstOperateur(2, lstOperateur(0, 0)) > Priorite _
Or lstOperateur(1, lstOperateur(0, 0)) <> Profondeur Then Exit Do
Pos = Pos + 1
lstElement(Pos) = lstOperateur(0, lstOperateur(0, 0))
lstOperateur(0, 0) = lstOperateur(0, 0) - 1
Loop
lstOperateur(0, 0) = lstOperateur(0, 0) + 1
lstOperateur(0, lstOperateur(0, 0)) = Car
lstOperateur(1, lstOperateur(0, 0)) = Profondeur
lstOperateur(2, lstOperateur(0, 0)) = Priorite
End Sub
'Function Formule Version 2 (legerement plus rapide )
Public Function Calcul(Car As String, XX As Single)
'Stop
Dim Var As Integer
RAM.Calcul(0) = lstElement(0)
For Var = 1 To Val(lstElement(0))
If lstElement(Var) = Car Then
RAM.Calcul(Var) = XX
Else
RAM.Calcul(Var) = lstElement(Var)
End If
RAM.Chaine(Var) = Var - 1
Next Var
For Var = 2 To Val(RAM.Calcul(0))
Select Case RAM.Calcul(Var)
Case "^"
RAM.Calcul(Var) = RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) ^ RAM.Calcul(RAM.Chaine(Var))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "/"
RAM.Calcul(Var) = RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) / RAM.Calcul(RAM.Chaine(Var))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "*"
RAM.Calcul(Var) = RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) * RAM.Calcul(RAM.Chaine(Var))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "\"
RAM.Calcul(Var) = RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) \ RAM.Calcul(RAM.Chaine(Var))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "D"
RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) = Replace(RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))), ",", ".")
RAM.Calcul(RAM.Chaine(Var)) = Replace(RAM.Calcul(RAM.Chaine(Var)), ",", ".")
RAM.Calcul(Var) = Val(RAM.Calcul(RAM.Chaine(RAM.Chaine(Var)))) - Fix(Val(RAM.Calcul(RAM.Chaine(RAM.Chaine(Var)))) / Val(RAM.Calcul(RAM.Chaine(Var)))) * Val(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "-"
RAM.Calcul(Var) = RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))) - RAM.Calcul(RAM.Chaine(Var))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "+"
RAM.Calcul(Var) = Val(Replace(RAM.Calcul(RAM.Chaine(RAM.Chaine(Var))), ",", ".")) + Val(Replace(RAM.Calcul(RAM.Chaine(Var)), ",", "."))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(RAM.Chaine(Var)))
Case "C"
RAM.Calcul(Var) = Cos(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "S"
RAM.Calcul(Var) = Sin(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "T"
RAM.Calcul(Var) = Tan(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "E"
RAM.Calcul(Var) = Exp(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "O"
RAM.Calcul(Var) = Atn(-RAM.Calcul(RAM.Chaine(Var)) / Sqr(-RAM.Calcul(RAM.Chaine(Var)) * RAM.Calcul(RAM.Chaine(Var)) + 1)) + 2 * Atn(1)
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "I"
RAM.Calcul(Var) = Atn(RAM.Calcul(RAM.Chaine(Var)) / Sqr(-RAM.Calcul(RAM.Chaine(Var)) * RAM.Calcul(RAM.Chaine(Var)) + 1))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "N"
RAM.Calcul(Var) = Atn(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "G"
RAM.Calcul(Var) = Log(RAM.Calcul(RAM.Chaine(Var))) / Log(10)
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "L"
RAM.Calcul(Var) = Log(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "Q"
RAM.Calcul(Var) = Sqr(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "A"
RAM.Calcul(Var) = Abs(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
Case "B" ' int()
RAM.Calcul(Var) = Int(RAM.Calcul(RAM.Chaine(Var)))
RAM.Chaine(Var) = RAM.Chaine(RAM.Chaine(Var))
End Select
Next Var
Formule = Val(Replace(RAM.Calcul(Var - 1), ",", "."))
Exit Function
Erreur:
Formule = "Indeterminé"
End Function
'Ancienne :
''''''''''''''''''''''''''''''''''''''''''''''''
' FORMULE CARTESIENNE, POLAIRE et SEQUENCIELLE '
''''''''''''''''''''''''''''''''''''''''''''''''
'Public Function Formule(XX As Single, Car As String, ByRef LST())
'
' Dim Var
' For Var = 0 To lstElement(0)
' If lstElement(Var) = Car Then
' RAM(Var) = XX
' Else
' RAM(Var) = lstElement(Var)
' End If
' Next Var
'
''RAM = lstElement
''For Var = 0 To RAM(0)
'' If RAM(Var) = Car Then RAM(Var) = XX
''Next Var
'Var = 2
'
' Do Until Var > Val(RAM(0))
' Select Case RAM(Var)
' Case "^"
' RAM(Var - 2) = RAM(Var - 2) ^ RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "/"
' RAM(Var - 2) = RAM(Var - 2) / RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "*"
' RAM(Var - 2) = RAM(Var - 2) * RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "E"
' RAM(Var - 2) = RAM(Var - 2) * 10 ^ RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
'
' Case "\"
' RAM(Var - 2) = RAM(Var - 2) \ RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "D"
' RAM(Var - 2) = Replace(RAM(Var - 2), ",", ".")
' RAM(Var - 1) = Replace(RAM(Var - 1), ",", ".")
' RAM(Var - 2) = Val(RAM(Var - 2)) - Fix(Val(RAM(Var - 2)) / Val(RAM(Var - 1))) * Val(RAM(Var - 1))
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "-"
' RAM(Var - 2) = RAM(Var - 2) - RAM(Var - 1)
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "+"
' RAM(Var - 2) = Val(Replace(RAM(Var - 2), ",", ".")) + Val(Replace(RAM(Var - 1), ",", "."))
' For V = Var - 1 To RAM(0)
' RAM(V) = RAM(V + 2)
' Next V
' RAM(0) = RAM(0) - 2
' Var = Var - 2
' Case "U"
' If Round(RAM(Var - 1), 0) > XX - 1 Then GoTo Erreur
' RAM(Var - 1) = LST(Round(RAM(Var - 1), 0))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "R"
' If Abs(Round(RAM(Var - 1), 0)) = 0 Then GoTo Erreur
' RAM(Var - 1) = LST(XX - Abs(Round(RAM(Var - 1), 0)))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
'
' Case "C"
' RAM(Var - 1) = Cos(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "S"
' RAM(Var - 1) = Sin(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "T"
' RAM(Var - 1) = Tan(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
'
' Case "O"
' RAM(Var - 1) = Atn(-RAM(Var - 1) / Sqr(-RAM(Var - 1) * RAM(Var - 1) + 1)) + 2 * Atn(1)
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "I"
' RAM(Var - 1) = Atn(RAM(Var - 1) / Sqr(-RAM(Var - 1) * RAM(Var - 1) + 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "N"
' RAM(Var - 1) = Atn(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
'
' Case "G"
' RAM(Var - 1) = Log(RAM(Var - 1)) / Log(10)
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "L"
' RAM(Var - 1) = Log(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "Q"
' RAM(Var - 1) = Sqr(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' Case "A"
' RAM(Var - 1) = Abs(RAM(Var - 1))
' For V = Var To RAM(0)
' RAM(V) = RAM(V + 1)
' Next V
' RAM(0) = RAM(0) - 1
' Var = Var - 1
' End Select
' Var = Var + 1
'Loop
'
'Formule = Val(Replace(RAM(1), ",", "."))
' Exit Function
'Erreur:
' Formule = "Indeterminé"
'End Function
Conclusion :
Apparement plus de 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.