Opérateur Logique

Programmation d'applications complexes
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Opérateur Logique

Message par Thyphoon »

Voici un code qui permet de résoudre des opérations logique contenu dans une chaine .... avec en théorie les priorités !
Or a la toute dernière opération il y a quelques choses qui cloche... est ce quelqu'un aurait une idée, je bloque !
merci d'avance ! :)

Code : Tout sélectionner

Procedure TestExpression(str.s)
    ProcedureReturn Val(str) ; Pour simplifier le teste on utilise juste de valeur ...
EndProcedure


Procedure.s TestCondition(param.s)
  Dim Mem(100)
  Id.l=0
  NbStartPar=CountString(param,"(")   ;Nombre de parenthèse de debug
  NbEndPar=CountString(param,")")     ;Nombre de parenthèse final
  If NbStartPar<>NbEndPar ; Si pas le même nombre il y a un problème
    Debug "Error ()";
    ProcedureReturn
  EndIf
  Debug "Chaine de depart"
  Debug param 
  ;Quelques remplacement de sécurité je dois avoir des espace entre les opérateur logique et le reste
  param=ReplaceString(UCase(param),"AND(","AND (")
  param=ReplaceString(UCase(param),"OR(","OR (")
  param=ReplaceString(UCase(param),")AND",") AND")
  param=ReplaceString(UCase(param),")OR",") OR")
  Debug "Correction des espace:"
  Debug param
  Repeat
    
      For l=1 To Len(param)
        str.s=""
        If Mid(param,l,1)="(" ;Si j'ai un debut de parenthèse je rajoute sa position sur la pile
          Id=Id+1
          Mem(Id)=l+1
        ElseIf l=1  ;Dans le cas ou j'ai une chaine sans parenthèse on comme si ...
          Id=Id+1
          Mem(Id)=l-1     
        ElseIf Mid(param,l,1)=")" ;J'ai une fin de parenthèse donc j'ai une chaine a traité
          str.s=Mid(param,Mem(Id),l-Mem(Id))
          NbEndPar-1 
        ElseIf l=Len(param) ;Dans le cas ou j'ai une chaine sans parenthèse on comme si ...
          str.s=Mid(param,Mem(Id),l-Mem(Id)+2)
          NbEndPar-1 
        EndIf
       
        
        If str<>"";On a une chaine a traiter alors on la traite
  ;_________________________________________
  
          Debug "parenthèse a traiter:"+str
          Nb=CountString(str," "); Nombre d'espace
          NbAnd=CountString(UCase(str),"AND");Nombre de "AND" a traiter
          NbOr=CountString(UCase(str),"OR")  ;Nombre de "OR" a trairer
          
          Repeat ; On repête le traitement tant qu'on a des opérateur logique
            
            ;Le Or est prioritaire donc on commence a le traiter
            If NbOr>0
              For z=1 To nb+1
                If StringField(UCase(str),z," ")="OR"
                  Debug "--OR--"
                  PartA.s=StringField(str,z-1," ")
                  PartB.s=StringField(str,z+1," ")
                  ResultA=TestExpression(PartA)
                  ResultB=TestExpression(PartB)
                  newstr.s=""
                  For t=1 To z-2
                    newstr+StringField(str,t," ")+" "
                  Next
                  newstr+Str(ResultA Or ResultB)+" "
                  For t=z+2 To nb+1
                    newstr+StringField(str,t," ")+" "
                  Next
                  NbOr-1
                  str=newstr
                  Debug "Or Result:"+str
                  Break
                EndIf
              Next
            ;Lorsqu'il n'y a plus de OR on traire les AND  
            ElseIf NbAnd
              For z=1 To nb
                If StringField(UCase(str),z," ")="AND"
                  Debug "--AND--"+str
                  PartA.s=StringField(str,z-1," ")
                  PartB.s=StringField(str,z+1," ")
                  ResultA=TestExpression(PartA)
                  ResultB=TestExpression(PartB)
                  newstr.s=""
                  For t=1 To z-2
                    newstr+StringField(str,t," ")+" "
                  Next
                  Debug "PartA:"+PartA
                  Debug "PartB:"+PartB
                  newstr+Str(ResultA And ResultB)+" "
                  For t=z+2 To nb+1
                    newstr+StringField(str,t," ")+" "
                  Next
                  NbAnd-1
                  str=newstr
                  Debug "And Result:"+str
                  Break
                EndIf
              Next
            EndIf
            Nb=CountString(str," ")
            NbAnd=CountString(UCase(str),"AND")
            NbOr=CountString(UCase(str),"OR")
          Until NbOr=0 And NbAnd=0 ; On repête le traitement tant qu'on a des opérateur logique
  
          ;________________________________________
           param=Left(param,Mem(Id)-2)+str+Right(param,Len(param)-l); On remplace la parenthèse traité part son resulta
           l=Len(Left(param,Mem(Id)-2)+str)-1;Nouvelle position du curseur
           param=ReplaceString(param,"  "," ")
           Debug "Nouvelle chaine:"+param

           Id-1
        EndIf

          
    Next
  Until NbEndPar<1
  ProcedureReturn Param
EndProcedure

Debug "-----"
Debug "result final:"+TestCondition("(1 Or(1 And(0 Or 1 And 1))And 1)")
Debug "-----"
End
Anonyme

Message par Anonyme »

ce code est sympa pour l'évaluation de chaine :

http://www.purebasic.fr/english/viewtop ... light=eval

Code : Tout sélectionner

;String math expression evaluator,  utopiomania 20070211
;PureBasic 4.00

Declare.f eval(str.s)
Declare.f level1()
Declare.f level2()
Declare.f level3()
Declare.f level4()
Declare.f level5()
Declare.f level6()
Declare.f level7()
Declare.f level8()
Declare.f level9()
Declare.f primitive()
Declare.f calc(op.s, num1.f, num2.f)
Declare.f unary(op.s, num.f)
Declare rewind()
Declare.f letVar(var.s, num.f)
Declare.f getVar()
Declare.f clearVars()
Declare gettoken()
Declare isFunc(str.s)
Declare isCommand(str.s)
Declare isMinus(str.s)
Declare isParenth(str.s)
Declare isDelim(str.s)
Declare notDelim(str.s)
Declare isAlpha(str.s)
Declare isDigit(str.s)
Declare isSpace(str.s)
Declare notVailidop(op.s)
Declare isErr(str.s)

;holds the expression to be evaluated:
Global expr.s
;Points to the next token in expression:
Global progr.l
;holds the token:
Global token.s
;token type:
Global ttype.l

#MAXVARS = 1000
Global Dim varNames.s(#MAXVARS)
Global Dim vars.f(#MAXVARS)

#MAXFNC = 11
Global Dim fnc.s(#MAXFNC)
fnc(0) = "ACOS": fnc(1) = "ASIN": fnc(2) = "ATAN": fnc(3) = "ABS"
fnc(4) = "COS": fnc(5) = "INT": fnc(6) = "LOG": fnc(7) = "LOG10"
fnc(8) = "SIN": fnc(9) = "SQR": fnc(10) = "TAN"

#MAXCMD = 1
Global Dim cmd.s(#MAXCMD)
cmd(0) = "CLEAR"

;token types:
#DELIM = 1
#VARIABLE = 2
#NUMBER = 3
#FUNCTION = 4
#COMMAND = 5

Global error.s
Global ERR_SYNTAX.s, ERR_PARENTH.s, ERR_NOEXPR.s, ERR_DIVZERO.s
ERR_SYNTAX = "SYNTAX ERROR"
ERR_PARENTH = "UNBALANCED PARENTHESES"
ERR_NOEXPR = "NO EXPRESSION"
ERR_DIVZERO = "DIVISION BY ZERO"

Procedure.f eval(str.s)
;entry point into parser
	progr = 1
	error = ""
	expr = UCase(str)
	gettoken()
	If token = ""
		error = ERR_NOEXPR
	EndIf
	isErr(expr)
	If Len(error)
		ProcedureReturn #False
	EndIf
	ProcedureReturn level1()
EndProcedure

Procedure.f level1()
;assignment statement/command
	typ.l
	tok.s
	If ttype= #VARIABLE
		;Save old token
		tok = token
		typ = ttype
		gettoken()
		If token = "="
			;assignment
			gettoken()
			ProcedureReturn letVar(tok, level2())
		Else
			;Restore
			Rewind()
			token = tok
			ttype = Typ
		EndIf
	ElseIf ttype = #COMMAND
		If token = "CLEAR"
			;Restore
			rewind()
			token = tok
			ttype = typ
			clearVars()
			ProcedureReturn 0
		EndIf
	EndIf
	ProcedureReturn level2()
EndProcedure

Procedure.f level2()
;logical  and/or 
	result.f = level3()
	op.s = token
	While (op = "&") Or (op = "|")
		gettoken()
		result = calc(op, result, level3())
		op = token
	Wend
	ProcedureReturn result
EndProcedure

Procedure.f level3()
;conditional operators
	result.f = level4()
	op.s = token
	While (op = "<") Or (op = ">") Or (op = "<>") Or (op = "<=") Or (op = ">=") Or (op = "==")
		gettoken()
		result = calc(op, result, level4())
		op = token
	Wend
	ProcedureReturn result
EndProcedure

Procedure.f level4()
;add or subtract two terms
	result.f = level5()
	op.s = token
	While (op = "+") Or (op = "-")
		gettoken()
		result = calc(op, result, level5())
		op = token
	Wend
	ProcedureReturn result
EndProcedure

Procedure.f level5()
;multiply,  divide
	result.f = level6()
	op.s = token
	While (op = "*") Or (op = "/")
		gettoken()
		result = calc(op, result, level6())
		op = token
	Wend
	ProcedureReturn result
EndProcedure

Procedure.f level6()
;Exponent
	result.f = level7()
	If token = "^"
		gettoken()
		result = calc("^", result, level7())
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.f level7()
;unary plus or minus
	op.s = ""
	If (ttype = #DELIM) And ((token = "+") Or (token = "-"))
		op = token
		gettoken()
	EndIf
	result.f = level8()
	If Len(op)
		result = Unary(op, result)
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.f level8()
;functions
	op.s = ""
	If ttype = #FUNCTION
		op = token
		gettoken()
	EndIf
	result.f = level9()
	If Len(op)
		result = calc(op, result, 0)
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.f level9()
;parenthesized expression
	result.f
	If (ttype = #DELIM) And (token = "(")
		gettoken()
		result = level1()
		gettoken()
	Else
		result = primitive()
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.f primitive()
;find value of number or variable
	result.f
	Select ttype
		Case #VARIABLE
			result = getVar()
			gettoken()
		Case #NUMBER
			result = ValF(token)
			gettoken()
		Default
			error = ERR_SYNTAX
	EndSelect
	ProcedureReturn result
EndProcedure

Procedure.f calc(op.s, num1.f, num2.f)
	result.f
	Select op
		Case "&"
			result = num1 And num2
		Case "|"
			result = num1 Or num2
		Case "<"
			If num1 < num2
				result = 1
			EndIf
		Case ">"
			If num1 > num2
				result = 1
			EndIf
		Case "<>"
			If num1 <> num2
				result = 1
			EndIf
		Case "<="
			If num1 <= num2
				result = 1
			EndIf
		Case ">="
			If num1 >= num2
				result = 1
			EndIf
		Case "=="
			If num1 = num2
				result = 1
			EndIf
		Case "-"
			result = num1 - num2
		Case "+"
			result = num1 + num2
		Case "*"
			result = num1 * num2
		Case "/"
			If num2 <> 0
				result = num1 / num2
			Else
				error = ERR_DIVZERO
				result = 0
			EndIf
		Case "^"
			result = Pow(num1, num2)
		Case "ACOS"
			result = ACos(num1)
		Case "ASIN"
			result = ASin(num1)
		Case "ATAN"
			result = ATan(num1)
		Case "ABS"
			result = Abs(num1)
		Case "COS"
			result = Cos(num1)
		Case "INT"
			result = Int(num1)
		Case "LOG"
			result = Log(num1)
		Case "LOG10"
			result = Log10(num1)
		Case "SIN"
			result = Sin(num1)
		Case "SQR"
			result = Sqr(num1)
		Case "TAN"
			result = Tan(num1)
	EndSelect
	ProcedureReturn result
EndProcedure

Procedure.f unary(op.s, num.f)
;unary minus
	If op = "-"
		ProcedureReturn -num
	EndIf
	ProcedureReturn num
EndProcedure

Procedure rewind()
;back up to the previous token
	progr = progr - Len(token)
EndProcedure

Procedure.f letVar(var.s, num.f)
;assign a value to a variable
	i = 0
	While Len(varNames(i))
		If var = varNames(i)
			vars(i) = num
			ProcedureReturn num
		EndIf
		i + 1
	Wend
	varNames(i) = var
	vars(i) = num
	ProcedureReturn num
EndProcedure

Procedure.f getVar()
;find value of a variable
	i = 0
	While Len(varNames(i))
		If token = varNames(i)
			ProcedureReturn vars(i)
		EndIf
		i + 1
	Wend
	letVar(token, 0)
	ProcedureReturn getVar()
EndProcedure

Procedure.f clearVars()
;clears variable names and values:
	For i = 0 To #MAXVARS - 1
		vars(i) = 0
		varNames(i) = ""
	Next
EndProcedure

Procedure getToken()
;get the next token/token type in expression
	ttype = 0
	token = ""
	If progr > Len(expr)
		ProcedureReturn
	EndIf 
	While isSpace(Mid(expr, progr, 1))
		Progr + 1
	Wend
	Select #True
		Case isMinus(Mid(expr, progr, 1))
			ttype = #DELIM
			token = Mid(expr, progr, 1)
			progr + 1
		Case isParenth(Mid(expr, progr, 1))
			ttype = #DELIM
			token = Mid(expr, progr, 1)
			progr + 1
		Case isDelim(Mid(expr, progr, 1))
			ttype = #DELIM
			While isDelim(Mid(expr, progr, 1))
				token + Mid(expr, progr, 1)
				progr + 1
			Wend
			If notVailidop(token)
				error = ERR_SYNTAX
			EndIf
		Case isAlpha(Mid(expr, progr, 1))
			While notDelim(Mid(expr, progr, 1))
				token + Mid(expr, progr, 1)
				progr + 1
			Wend
			If isFunc(token)
				ttype= #FUNCTION
			Else
				If isCommand(token)
					ttype = #COMMAND
				Else
					ttype = #VARIABLE
				EndIf
			EndIf
		Case isDigit(Mid(expr, progr, 1))
			ttype = #NUMBER   
			While NotDelim(Mid(expr, progr, 1))
				token + Mid(expr, progr, 1)
				progr + 1
			Wend
	EndSelect
EndProcedure

Procedure isFunc(str.s)
	For i = 0 To #MAXFNC - 1
		If str = fnc(i)
			ProcedureReturn #True
		EndIf
	Next
	ProcedureReturn #False
EndProcedure

Procedure isCommand(str.s)
	For i = 0 To #MAXCMD - 1
		If str = cmd(i)
			ProcedureReturn #True
		EndIf
	Next
	ProcedureReturn #False
EndProcedure

Procedure isMinus(str.s)
	If FindString("-", str, 1)
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure isParenth(str.s)
	If FindString("()", str, 1)
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure isDelim(str.s)
	If (FindString("&|<>+/*^=", str, 1) > 0) And (str <> "")
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure NotDelim(str.s)
	If (FindString("&|<>+-/*^=()" + Chr(32) + Chr(9), str, 1) > 0) Or (str = "")
		ProcedureReturn #False
	EndIf
	ProcedureReturn #True
EndProcedure

Procedure isAlpha(str.s)
	If FindString("ABCDEFGHIJKLMNOPQRSTUVWXYZ", str, 1)
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure isDigit(str.s)
	If FindString(".0123456789", str, 1)
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure isSpace(str.s)
	If ((str = " ") Or (str = Chr(9))) And (str <> "")
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure

Procedure notVailidop(op.s)
	If Len(op) = 1
		ProcedureReturn #False
	EndIf
	Select token
		Case "<>"
			ProcedureReturn #False
		Case "<= "
			ProcedureReturn #False
		Case ">= "
			ProcedureReturn #False
		Case "== "
			ProcedureReturn #False
		Case "--"
			ProcedureReturn #False
	EndSelect
	ProcedureReturn #True
EndProcedure

Procedure isErr(str.s)
;Check for some errors
	str1.s
	str2.s
	err = 0
	str = UCase(str)
	;Check for unbalanced parentheses
	For i = 1 To Len(str)
		If Mid(str, i, 1) = "("
			err + 1
		EndIf
		If Mid(str, i, 1) = ")"
			err - 1
		EndIf
	Next
	If err
		error = ERR_PARENTH
		ProcedureReturn #True
	EndIf
	;Check for Illegal characters
	str1 = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	str2 = "0123456789.&|<>+-/%*^=()" + Chr(9)
	For i = 1 To Len(str)
		If FindString(str1 + str2, Mid(str, i, 1), 1) = 0
			err + 1
		EndIf
	Next
	If err
		ProcedureReturn #True
	EndIf
	ProcedureReturn #False
EndProcedure


;DEMO
OpenConsole()
ConsoleTitle("Expression evaluator")

eval("a = 10")
eval("b = 25.25")
PrintN(StrF(eval("a * b")))

PrintN("[Enter] to end...")
Input()
end
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

Merci Cpl.Bator effectivement ton code est vraiment tres sympa !
je vais étudier comment il fait ... lolllllllll je suis têtu j'aimerais réussir a faire fonctionner mon code lollllll
Merci beaucoup en tout cas

Edit : Ton code est genial ...j'arrive pas a tout comprendre de son fonctionnement mais c'est génial ...
zaphod
Messages : 135
Inscription : dim. 07/déc./2008 9:32

Message par zaphod »

ca semble marcher comme ça :

Code : Tout sélectionner

Procedure TestExpression(str.s) 
    ProcedureReturn Val(str) ; Pour simplifier le teste on utilise juste de valeur ... 
EndProcedure 


Procedure.s TestCondition(param.s) 
  Dim Mem(100) 
  Id.l=0 
  NbStartPar=CountString(param,"(")   ;Nombre de parenthèse de debug 
  NbEndPar=CountString(param,")")     ;Nombre de parenthèse final 
  If NbStartPar<>NbEndPar ; Si pas le même nombre il y a un problème 
    Debug "Error ()"; 
    ProcedureReturn 
  EndIf 
  Debug "Chaine de depart" 
  Debug param 
  ;Quelques remplacement de sécurité je dois avoir des espace entre les opérateur logique et le reste 
  param=ReplaceString(UCase(param),"AND(","AND (") 
  param=ReplaceString(UCase(param),"OR(","OR (") 
  param=ReplaceString(UCase(param),")AND",") AND") 
  param=ReplaceString(UCase(param),")OR",") OR") 
  Debug "Correction des espace:" 
  Debug param 
  Repeat 
    
      For l=1 To Len(param) 
        str.s="" 
        If Mid(param,l,1)="(" ;Si j'ai un debut de parenthèse je rajoute sa position sur la pile 
          Id=Id+1 
          Mem(Id)=l+1 
        ElseIf l=1  ;Dans le cas ou j'ai une chaine sans parenthèse on comme si ... 
          Id=Id+1 
          Mem(Id)=l-1      
        ElseIf Mid(param,l,1)=")" ;J'ai une fin de parenthèse donc j'ai une chaine a traité 
          str.s=Mid(param,Mem(Id),l-Mem(Id)) 
          NbEndPar-1 
        ElseIf l=Len(param) ;Dans le cas ou j'ai une chaine sans parenthèse on comme si ... 
          str.s=Mid(param,Mem(Id),l-Mem(Id)+2) 
          NbEndPar-1 
        EndIf 
        
        
        If str<>"";On a une chaine a traiter alors on la traite 
  ;_________________________________________ 
  
          Debug "parenthèse a traiter:"+str 
          Nb=CountString(str," "); Nombre d'espace 
          NbAnd=CountString(UCase(str),"AND");Nombre de "AND" a traiter 
          NbOr=CountString(UCase(str),"OR")  ;Nombre de "OR" a trairer 
          
          Repeat ; On repête le traitement tant qu'on a des opérateur logique 
            
            ;Le Or est prioritaire donc on commence a le traiter 
            If NbOr>0 
              For z=1 To nb+1 
                If StringField(UCase(str),z," ")="OR" 
                  Debug "--OR--" 
                  PartA.s=StringField(str,z-1," ") 
                  PartB.s=StringField(str,z+1," ") 
                  ResultA=TestExpression(PartA) 
                  ResultB=TestExpression(PartB) 
                  newstr.s="" 
                  For t=1 To z-2 
                    newstr+StringField(str,t," ")+" " 
                  Next 
                  newstr+Str(ResultA Or ResultB)+" " 
                  For t=z+2 To nb+1 
                    newstr+StringField(str,t," ")+" " 
                  Next 
                  NbOr-1 
                  str=newstr 
                  Debug "Or Result:"+str 
                  Break 
                EndIf 
              Next 
            ;Lorsqu'il n'y a plus de OR on traire les AND  
            ElseIf NbAnd 
              For z=1 To nb 
                If StringField(UCase(str),z," ")="AND" 
                  Debug "--AND--"+str 
                  PartA.s=StringField(str,z-2," ") ;zaphod
                  PartB.s=StringField(str,z+1," ") 
                  ResultA=TestExpression(PartA) 
                  ResultB=TestExpression(PartB) 
                  newstr.s="" 
                  For t=1 To z-2 
                    newstr+StringField(str,t," ")+" " 
                  Next 
                  Debug "PartA:"+PartA 
                  Debug "PartB:"+PartB 
                  newstr+Str(ResultA And ResultB)+" " 
                  For t=z+2 To nb+1 
                    newstr+StringField(str,t," ") ;+" "  ;zaphod
                  Next 
                  NbAnd-1 
                  str=newstr 
                  Debug "And Result:"+str 
                  Break 
                EndIf 
              Next 
            EndIf 
            Nb=CountString(str," ") 
            NbAnd=CountString(UCase(str),"AND") 
            NbOr=CountString(UCase(str),"OR") 
          Until NbOr=0 And NbAnd=0 ; On repête le traitement tant qu'on a des opérateur logique 
  
          ;________________________________________ 
           param=Left(param,Mem(Id)-2)+str+Right(param,Len(param)-l); On remplace la parenthèse traité part son resulta 
           l=Len(Left(param,Mem(Id)-2)+str)-1;Nouvelle position du curseur 
           param=ReplaceString(param,"  "," ") 
           Debug "Nouvelle chaine:"+param 

           If id>0 ;zaphod
           Id-1 
           Else
           Break
           EndIf
        EndIf 

          
    Next 
  Until NbEndPar<1 
  ProcedureReturn Param 
EndProcedure 

Debug "-----" 
Debug "result final:"+TestCondition("(1 Or(1 And(0 Or 1 And 1))And 1)") 
Debug "-----" 
End 
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Message par Thyphoon »

Merci beaucoup zaphod ! tu as trouvé !!
Bon je vis voir si je peux pas faire mieux car c'est un peu lourd et pas toujours fiable .... Merci beaucoup
Répondre