Je viens tout juste de prendre le temps de l'adapter à purebasic
ça manque d'explications, je mettrai le lien du site où j'ai trouvé ce code dès que je le retrouve.
Code : Tout sélectionner
;Comtois 21/01/05
;automate de validation d'une expression arithmétique
#etats = 5
#caracs = 16 ; 16 caractères autorisés pour la saisie
Dim tab(#etats,#caracs)
For e=1 To #etats
For c=1 To #caracs
Read tab(e,c)
Next c
Next e
Procedure.s Automate(s.s)
If s=""
ProcedureReturn "Chaîne vide"
EndIf
st.s = "0123456789+-*/()" ; les 16 caractères possibles
equilibre=0 ; comptage des parenthèses
p=0 ; position courante dans la chaîne s
etat=1 ; Etat initial
result.s="" ; Resultat du test de l'expression
Repeat
p+1
car.s=Mid(s,p,1) ; caractère en cours
If car="(" : equilibre+1 : EndIf
If car=")" : equilibre-1 : EndIf
If equilibre>=0
; position du caractère en cours dans la chaîne de caractères autorisés
n=FindString(st,car,1)
If n>0 : etat=tab(etat,n) : EndIf ; c'est un caractère autorisé
EndIf
Until (p=Len(s)) Or (equilibre<0) Or (n=0) Or (etat=0)
If equilibre<0
result="Il y a une parenthèse fermante en trop à la position " + Str(p)
ElseIf equilibre>0
result="Il y a une parenthèse ouvrante en trop"
ElseIf n=0
result="Caractère non autorisé à la position " + Str(p)
ElseIf etat=0
result="Expression incorrecte (erreur à la position " + Str(p) + ")"
ElseIf etat<>3 And etat<>4
result="Expression incorrecte (etat final non terminal)"
Else
result="Expression correcte"
EndIf
ProcedureReturn result
EndProcedure
;Test quelques expressions
Debug Automate("1+3)-4*2/6+(8-4)")
Debug Automate("1+3-(4*2/6+(8-4)")
Debug Automate("1+3-a*2/6+(8-4)")
Debug Automate("1+3-4*-2/6+(8-4)")
Debug Automate("1+3-4*2/6+(8-4)")
End
DataSection
; 0 1 2 3 4 5 6 7 8 9 + - * / ( )
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 0, 0, 1, 0 ; {etat 1}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 1, 0 ; {etat 2}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 5, 5, 5, 0, 4 ; {etat 3}
Data.l 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 5, 5, 5, 0, 4 ; {etat 4}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 1, 0 ; {etat 5}
EndDataSection