PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Tester une expression régulière

http://forums.purebasic.com/french/viewtopic.php?t=9948

Page 1 sur 1

Tester une expression régulière

Publié : ven. 13/nov./2009 20:32
par Le Soldat Inconnu
Les expressions régulières ne sont pas forcément évidente à trouver.

Alors j'ai fais ce petit code qui permet de tester son expression régulière en direct. C'est plus sympa et plus rapide pour faire les essais

le code sauve ces paramètres dans un fichier de préférences "RegularExpression.ini", ça permet de le fermer et de l'ouvrir sans perdre les valeurs de tests

Code : Tout sélectionner

#Nb_Test = 10
Global Dim Test.s(#Nb_Test)
Global Expression.s

OpenPreferences("RegularExpression.ini")
Expression = ReadPreferenceString("Expression", "")
For Index = 1 To #Nb_Test
	Test(Index) = ReadPreferenceString("Test" +Str(Index), "")
Next
ClosePreferences()

Procedure TestExpression()
	If CreateRegularExpression(0, Expression)
		For Index = 1 To #Nb_Test
			If MatchRegularExpression(0, Test(Index))
				SetGadgetColor(Index, #PB_Gadget_BackColor, $AFFFDB)
			Else
				SetGadgetColor(Index, #PB_Gadget_BackColor, $75D9FF)
			EndIf
		Next
		FreeRegularExpression(0)
	Else
		For Index = 1 To #Nb_Test
			SetGadgetColor(Index, #PB_Gadget_BackColor, $9D9DFF)
		Next
	EndIf
EndProcedure

If OpenWindow(0, 0, 0, 500, 24 + 8 + 24 * #Nb_Test + 8 + 24, "RegularExpression", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
	
	Font = LoadFont(0, "Verdana", 10, #PB_Font_HighQuality)
	
	TextGadget(#PB_Any, 0, 0, 80, 24, "Expression ", #PB_Text_Right)
	StringGadget(0, 80, 0, 500 - 80, 24, Expression)
	SetGadgetFont(0, Font)
	
	For Index = 1 To #Nb_Test
		TextGadget(#PB_Any, 0, 8 + 24 * Index, 80, 24, "Test " + Str(Index) + " ", #PB_Text_Right)
		StringGadget(Index, 80, 8 + 24 * Index, 500 - 80, 24, Test(Index))
		SetGadgetFont(Index, Font)
	Next
	
	ButtonGadget(#Nb_Test + 1, 80, 24 * #Nb_Test + 8 + 24, 64, 24, "Test")
	TestExpression()
	
	Repeat
		Event = WaitWindowEvent()
		Select Event
			Case #PB_Event_Gadget
				Select EventGadget()
					Case 0
						Expression = GetGadgetText(0)
						TestExpression()
						
					Case #Nb_Test + 1
						; Test de l'expression régulière
						TestExpression()
						
					Default
						If GadgetType(EventGadget()) = #PB_GadgetType_String
							Test(EventGadget()) = GetGadgetText(EventGadget())
							TestExpression()
						EndIf
				EndSelect
		EndSelect
		
	Until Event = #PB_Event_CloseWindow
	
	
	
	
EndIf




If CreatePreferences("RegularExpression.ini")
	WritePreferenceString("Expression", Expression)
	For Index = 1 To #Nb_Test
		WritePreferenceString("Test" +Str(Index), Test(Index))
	Next
	ClosePreferences()
EndIf
pour ceux qui veulent une base de test, vous pouvez copier ceci dans un fichier "RegularExpression.ini" placé à coté du code

Code : Tout sélectionner

Expression = ^(http://|https://|ftp://|www.)[a-z0-9._-]+\.[a-z]{2,4}$
Test1 = www.lsi-dev.com
Test2 = http://www.lsi-dev.com
Test3 = ftp://lsi_dev.com
Test4 = www.Azerti.fr
Test5 = www.zertert retrty.com
Test6 = www.truc.machin
Test7 = ftp://bidule.truc.com
Test8 = www.
Test9 = fdshj
Test10 =

Re: Tester une expression régulière

Publié : sam. 14/nov./2009 11:45
par Thyphoon
tres pratique !! :) merci pour ce partage !

Re: Tester une expression régulière

Publié : sam. 05/déc./2009 15:40
par dayvid
et comment évaluer une expréssion dans un fichier

exemple:


125 + 5 * 8 / 56 -458


le programme calcule tout sa et renvoie le resulta

Re: Tester une expression régulière

Publié : sam. 05/déc./2009 16:08
par Thyphoon
eu non là il faut une fonction d'évaluation !
regarde ici sur le forum anglais tu devrais trouver ton bonheurs:
http://www.purebasic.fr/english/viewtop ... hilit=eval

Il y en a aussi sur le forum allemand !

Re: Tester une expression régulière

Publié : sam. 05/déc./2009 16:42
par dayvid
heu, ya rien en français :oops:

Re: Tester une expression régulière

Publié : sam. 05/déc./2009 17:10
par Thyphoon
dayvid a écrit :heu, ya rien en français :oops:
faut tout leur maché au petit jeune lolllllllll tu remercira Dobro car c'est lui qui me l'avait passé ! !

Code : Tout sélectionner

#NUM = "0123456789"
#STRIN ="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

; *************************************************************
;-*** D E C L A R E ***




;Operanten-Codes
#OP_UNKNOWN         = -1
#OP_NONE            = 0
#OP_PLUS            = 1
#OP_MINUS           = 2
#OP_MULT            = 3
#OP_DIV             = 4
#OP_POT             = 5
#OP_FUNC            = 6

;Funktions-Codes
#FUNC_SQR           = 1
#FUNC_SIN           = 2
#FUNC_ASIN          = 3
#FUNC_COS           = 4
#FUNC_ACOS          = 5
#FUNC_TAN           = 6
#FUNC_ATAN          = 7
#FUNC_INT           = 8
#FUNC_ABS           = 9
#FUNC_LOG10         = 10
#FUNC_LOG           = 11

;Konstanten
#CONST_PI           = "3.1415926"   ;PI
#CONST_E            = "2.7182818"   ;Eulersche Zahl

;Error-Codes
#CALC_ERR_NONE          = 0         ;kein Fehler
#CALC_ERR_SYNTAX        = 1         ;Allgemeiner Syntax-Fehler (fehlender Wert)
#CALC_ERR_DIVNULL       = 2         ;Division / 0 aufgetreten
#CALC_ERR_OPNOTFOUND    = 3         ;Operant nicht gefunden
#CALC_ERR_FUNCNOTFOUND  = 4         ;Funktion nicht gefunden

#PRIORITY_STEP      = 4             ;entspricht der höchsten Prioritätsstufe der Operanten
#MAX_TREENODES      = 100           ;Maximale Anzahl an SyntaxBaum-Knoten

#OPERAND            = 1
#VALUE              = 2

Structure SyntaxTreeNode
    *parent.SyntaxTreeNode
    *child.SyntaxTreeNode[2]
    operand.l
    prior.l
    Value.f
EndStructure

Structure SyntaxTree
    *root.SyntaxTreeNode
    node.SyntaxTreeNode[#MAX_TREENODES]
    remark$ ;frei verwendbar
EndStructure





; *************************************************************************************
Declare.l Calc_Modulo(a.l, b.l)
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode)
Declare.s Calc_GetContent(*expression, type.l, *pos.Long)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
Declare.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
Declare Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
Declare Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$)
Declare.f CalculateSyntaxTreeF(*tree.SyntaxTree)
Declare.l CalculateSyntaxTreeL(*tree.SyntaxTree)
Declare.l CalculateL(expression$)
Declare.f CalculateF(expression$)
Declare.l GetCalculationError()
Declare EnableFunctionCalculation(bool.b)
Declare EnableConstantCalculation(bool.b)
EnableFunctionCalculation(1)
EnableConstantCalculation(1)

; *************************************************************************************

Procedure.l Calc_Modulo(a.l, b.l)
    ProcedureReturn a - a / b * b
EndProcedure
 
Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode)
    Shared priorMod.l
   
    While PeekB(@operand$) = 41 ;Left(operand$, 1) = ")"
        operand$ = Mid(operand$, 2, Len(operand$))
        priorMod - #PRIORITY_STEP
    Wend
   
    While PeekB(@operand$ + Len(operand$) - 1) = 40 ;Right(operand$, 1) = "("
        operand$ = Left(operand$, Len(operand$) - 1)
        changePrior.l + #PRIORITY_STEP
    Wend
   
    Select operand$
        Case "+"
            *node\operand = #OP_PLUS
            *node\prior = priorMod + 1
        Case "-"
            *node\operand = #OP_MINUS
            *node\prior = priorMod + 1
        Case "*"
            *node\operand = #OP_MULT
            *node\prior = priorMod + 2
        Case "/"
            *node\operand = #OP_DIV
            *node\prior = priorMod + 2
        Case "^"
            *node\operand = #OP_POT
            *node\prior = priorMod + 3
           
           
        Case "~"
            *node\operand = #OP_FUNC
            ;ACHTUNG: Funktionen müssen IMMMER die höchste Priorität besitzen
            *node\prior = priorMod + 4
        Default
            *node\operand = #OP_UNKNOWN
    EndSelect
   
    priorMod + changePrior
EndProcedure
 
Procedure.s Calc_GetContent(*expression, type.l, *pos.Long)
    *pointer.Byte = *expression + *pos\l
   
    If type = #VALUE
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer) = 45 ; '-'
            *pointer + 1
        EndIf
       
        ;) + - * / ^ ~ \0
        ;Ascii-Wert eines neuen Operators hier mit einfügen
        While (*pointer\b < 97 Or *pointer\b > 122) And *pointer\b <> 41 And *pointer\b <> 42 And *pointer\b <> 43  And *pointer\b <> 45 And *pointer\b <> 47 And *pointer\b <> 94 And *pointer\b <> 126 And *pointer\b <> 0
            *pointer + 1
        Wend
    Else
        ;0-9 .
        While (*pointer\b < 48 Or *pointer\b > 57) And *pointer\b <> 46 And *pointer\b <> 0
            *pointer + 1
        Wend
        ;(-x) Ausrdrücke zulassen
        If PeekB(*pointer - 1) = 45 And PeekB(*pointer - 2) = 40 ; '(-'
            *pointer - 1
        EndIf
    EndIf
   
    a_RET$ = PeekS(*expression + *pos\l, (*pointer - *expression) - *pos\l)
   
    If *pointer\b
        *pos\l = *pointer - *expression
    Else
        *pos\l = -1
    EndIf
   
    ProcedureReturn a_RET$
EndProcedure
 
Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
    child.l
   
    If *nodeTarget\parent
        If *nodeTarget\parent\child[0] = *nodeTarget
            child = 0
        ElseIf *nodeTarget\parent\child[1] = *nodeTarget
            child = 1
        EndIf
        *nodeTarget\parent\child[child] = *nodeInsert
        *nodeInsert\parent = *nodeTarget\parent
    EndIf
    *nodeTarget\parent = *nodeInsert
    *nodeInsert\child[0] = *nodeTarget
EndProcedure
 
Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
    If *nodeTarget\child[child]
        *nodeChild.SyntaxTreeNode = *nodeTarget\child[child]
        *nodeChild\parent = *nodeInsert
        *nodeInsert\child[0] = *nodeTarget\child[child]
    EndIf
   
    *nodeTarget\child[child] = *nodeInsert
    *nodeInsert\parent = *nodeTarget
EndProcedure
 
Procedure.f Calc_GetNodeValueF(*node.SyntaxTreeNode)
    Shared calculationErrorOccured.b
    Result.f
   
    If *node
        If *node\operand
            valueOne.f = Calc_GetNodeValueF(*node\child[0])
            valueTwo.f = Calc_GetNodeValueF(*node\child[1])
            Select *node\operand
                Case #OP_PLUS
                    Result = valueOne + valueTwo
                Case #OP_MINUS
                    Result = valueOne - valueTwo
                Case #OP_MULT
                    Result = valueOne * valueTwo
                Case #OP_DIV
                    Result = valueOne / valueTwo
                    If valueTwo = 0 And calculationErrorOccured = 0
                        calculationErrorOccured = #CALC_ERR_DIVNULL
                    EndIf
                Case #OP_POT
                    Result = Pow(valueOne, valueTwo)
                   
                Case #OP_FUNC
                    Select valueOne ;steht für den Funktionstyp
                        Case #FUNC_SQR
                            Result = Sqr(valueTwo)
                        Case #FUNC_SIN
                            Result = Sin(valueTwo)
                        Case #FUNC_ASIN
                            Result = ASin(valueTwo)
                        Case #FUNC_COS
                            Result = Cos(valueTwo)
                        Case #FUNC_ACOS
                            Result = ACos(valueTwo)
                        Case #FUNC_TAN
                            Result = Tan(valueTwo)
                        Case #FUNC_ATAN
                            Result = ATan(valueTwo)
                        Case #FUNC_INT
                            Result = Int(valueTwo)
                        Case #FUNC_ABS
                            Result = Abs(valueTwo)
                        Case #FUNC_LOG10
                            Result = Log10(valueTwo)
                        Case #FUNC_LOG
                            Result = Log(valueTwo)
                        Default
                            calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND
                    EndSelect
                   
                Case #OP_UNKNOWN
                    calculationErrorOccured = #CALC_ERR_OPNOTFOUND
            EndSelect
            ProcedureReturn Result
        Else
            ProcedureReturn *node\Value
        EndIf
    Else
        calculationErrorOccured = 1
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l)
    ;für Debugging und Veranschaulischungszwecke
    Shared isFunction.b
   
    If *node
       
        If  *node\operand
            If *node\operand = #OP_PLUS
                PrintN(Space(level * 2) + "+")
            ElseIf *node\operand = #OP_MINUS
                PrintN(Space(level * 2) + "-")
            ElseIf *node\operand = #OP_MULT
                PrintN(Space(level * 2) + "*")
            ElseIf *node\operand = #OP_DIV
                PrintN(Space(level * 2) + "/")
            ElseIf *node\operand = #OP_POT
                PrintN(Space(level * 2) + "^")
            ElseIf *node\operand = #OP_FUNC
                isFunction = 1
            EndIf
        Else
            If isFunction
                Print(Space((level-1) * 2))
                Select *node\Value
                    Case #FUNC_SQR
                        PrintN("SQR")
                    Case #FUNC_SIN
                        PrintN("SIN")
                    Case #FUNC_ASIN
                        PrintN("ASIN")
                    Case #FUNC_COS
                        PrintN("COS")
                    Case #FUNC_ACOS
                        PrintN("ACOS")
                    Case #FUNC_TAN
                        PrintN("TAN")
                    Case #FUNC_ATAN
                        PrintN("ATAN")
                    Case #FUNC_INT
                        PrintN("INT")
                    Case #FUNC_ABS
                        PrintN("ABS")
                    Case #FUNC_LOG10
                        PrintN("LOGTEN")
                    Case #FUNC_LOG
                        PrintN("LOG")
                EndSelect
            Else
                PrintN(Space(level * 2) + StrF(*node\Value))
            EndIf
        EndIf
       
        If *node\child[0]
            Calc_ConsoleOutSyntaxNode(*node\child[0], level + 1)
            isFunction = 0
        EndIf
        If *node\child[1]
            Calc_ConsoleOutSyntaxNode(*node\child[1], level + 1)
        EndIf
    EndIf
EndProcedure
 
Procedure Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
    ;für Debugging und Veranschaulischungszwecke
    Calc_ConsoleOutSyntaxNode(*tree\root, 0)
EndProcedure
 
  ;--    Public
 
Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$)
    Shared priorMod.l, functionCalculationEnabled.b, constantCalculationEnabled.b
   
    priorMod = 0
    nodeCount.l = 0
    Position.l = 0
   
    *nodeLastValue.SyntaxTreeNode
    *nodeCurrentValue.SyntaxTreeNode
    *nodeLastOperand.SyntaxTreeNode
    *nodeCurrentOperand.SyntaxTreeNode
   
    expression$ = LCase(ReplaceString(expression$, " ", ""))
   
    While Left(expression$, 1) = "("
        expression$ = Mid(expression$, 2, Len(expression$))
        priorMod + #PRIORITY_STEP
    Wend
    While Right(expression$, 1) = ")"
        expression$ = Left(expression$, Len(expression$) - 1)
    Wend
   
    If functionCalculationEnabled
        expression$ = ReplaceString(expression$, "sqr",   Str(#FUNC_SQR) + "~")
        expression$ = ReplaceString(expression$, "asin",  Str(#FUNC_ASIN) + "~")
        expression$ = ReplaceString(expression$, "sin",   Str(#FUNC_SIN) + "~")
        expression$ = ReplaceString(expression$, "acos",  Str(#FUNC_ACOS) + "~")
        expression$ = ReplaceString(expression$, "cos",   Str(#FUNC_COS) + "~")
        expression$ = ReplaceString(expression$, "atan",  Str(#FUNC_ATAN) + "~")
        expression$ = ReplaceString(expression$, "tan",   Str(#FUNC_TAN) + "~")
        expression$ = ReplaceString(expression$, "int",   Str(#FUNC_INT) + "~")
        expression$ = ReplaceString(expression$, "abs",   Str(#FUNC_ABS) + "~")
        expression$ = ReplaceString(expression$, "logten",Str(#FUNC_LOG10) + "~")
        expression$ = ReplaceString(expression$, "log",   Str(#FUNC_LOG) + "~")
    EndIf
   
    If constantCalculationEnabled
        expression$ = ReplaceString(expression$, "pi", #CONST_PI)
        expression$ = ReplaceString(expression$, "e",  #CONST_E)
    EndIf
   
    ;Debug expression$
   
    Repeat
        nodeCount + 1
       
        If Calc_Modulo(nodeCount, 2) ;Wert
            node$ = Calc_GetContent(@expression$, #VALUE, @Position)
            *tree\node[nodeCount]\Value = ValF(node$)
            *nodeCurrentValue = *tree\node[nodeCount]
            ;Debug node$
           
            If nodeCount > 1
                Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue)
            EndIf
           
            *nodeLastValue = *nodeCurrentValue
        Else ;Operator
            node$ = Calc_GetContent(@expression$, #OPERAND, @Position)
            Calc_SetOperand(node$, *tree\node[nodeCount])
           
            *nodeCurrentOperand = *tree\node[nodeCount]
            ;Debug node$ + " :: " + Str(*nodeCurrentOperand\prior)
           
            If *nodeLastOperand
                If *nodeCurrentOperand\prior > *nodeLastOperand\prior
                    Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand)
                ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior
                    Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand)
                Else
                    *node.SyntaxTreeNode = *nodeLastOperand
                    While *node\parent And *node\prior > *nodeCurrentOperand\prior
                        *node = *node\parent
                    Wend
                   
                    If *node\prior = *nodeCurrentOperand\prior
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    ElseIf *node\prior < *nodeCurrentOperand\prior
                        Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand)
                    Else
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
                    EndIf
                EndIf
            Else
                Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand)
            EndIf
           
            *nodeLastOperand = *nodeCurrentOperand
        EndIf
       
    Until Position = -1
   
    If *nodeLastOperand
        While *nodeLastOperand\parent
            *nodeLastOperand = *nodeLastOperand\parent
        Wend
        *tree\root = *nodeLastOperand
    ElseIf nodeCount = 1
        *tree\root = *nodeLastValue
    Else
        *tree\root = 0
    EndIf
   
EndProcedure
 
Procedure.f CalculateSyntaxTreeF(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.f = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateSyntaxTreeL(*tree.SyntaxTree)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    If *tree\root
        Result.l = Calc_GetNodeValueF(*tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l CalculateL(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(@tree, expression$)
   
    If tree\root
        Result.l = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.f CalculateF(expression$)
    Shared calculationErrorOccured.b
    calculationErrorOccured = 0
   
    tree.SyntaxTree
    CreateSyntaxTree(tree, expression$)
   
    If tree\root 
        ;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden
        Shared outputSyntaxTree.b
        If outputSyntaxTree
            Calc_ConsoleOutSyntaxTree(tree)
        EndIf
       
        Result.f = Calc_GetNodeValueF(tree\root)
    Else
        ;Fehler auslösen
        calculationErrorOccured = 1
        Result.f = 0 / Result
    EndIf
   
    ProcedureReturn Result
EndProcedure
 
Procedure.l GetCalculationError()
    Shared calculationErrorOccured.b
    ProcedureReturn calculationErrorOccured
EndProcedure
 
Procedure EnableFunctionCalculation(bool.b)
    Shared functionCalculationEnabled.b
    functionCalculationEnabled = bool
EndProcedure
 
Procedure EnableConstantCalculation(bool.b)
    Shared constantCalculationEnabled.b
    constantCalculationEnabled = bool
EndProcedure
 
Debug CalculateF("125 + 5 * 8 / 56 -458")

Re: Tester une expression régulière

Publié : mer. 09/déc./2009 18:19
par dayvid
trop cool, merci !!! :P

Re: Tester une expression régulière

Publié : jeu. 10/déc./2009 1:24
par Le Soldat Inconnu
j'ai tout convertit avec le support du Quad et Double pour une meilleur précision.

C'est un très beau code :)
Bien plus léger que mon usine à gaz de ma calculette

Code : Tout sélectionner

#NUM = "0123456789"
#STRIN ="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

; *************************************************************
;-*** D E C L A R E ***




;Operanten-Codes
#OP_UNKNOWN         = -1
#OP_NONE            = 0
#OP_PLUS            = 1
#OP_MINUS           = 2
#OP_MULT            = 3
#OP_DIV             = 4
#OP_POT             = 5
#OP_FUNC            = 6

;Funktions-Codes
#FUNC_SQR           = 1
#FUNC_SIN           = 2
#FUNC_ASIN          = 3
#FUNC_COS           = 4
#FUNC_ACOS          = 5
#FUNC_TAN           = 6
#FUNC_ATAN          = 7
#FUNC_INT           = 8
#FUNC_ABS           = 9
#FUNC_LOG10         = 10
#FUNC_LOG           = 11

;Konstanten
#CONST_PI           = "3.14159265358979323846264338327950288419"   ;PI
#CONST_E            = "2,718281828459045235360287"   ;Eulersche Zahl

;Error-Codes
#CALC_ERR_NONE          = 0         ;kein Fehler
#CALC_ERR_SYNTAX        = 1         ;Allgemeiner Syntax-Fehler (fehlender Wert)
#CALC_ERR_DIVNULL       = 2         ;Division / 0 aufgetreten
#CALC_ERR_OPNOTFOUND    = 3         ;Operant nicht gefunden
#CALC_ERR_FUNCNOTFOUND  = 4         ;Funktion nicht gefunden

#PRIORITY_STEP      = 4             ;entspricht der höchsten Prioritätsstufe der Operanten
#MAX_TREENODES      = 100           ;Maximale Anzahl an SyntaxBaum-Knoten

#OPERAND            = 1
#VALUE              = 2

Structure SyntaxTreeNode
	*parent.SyntaxTreeNode
	*child.SyntaxTreeNode[2]
	operand.i
	prior.i
	Value.d
EndStructure

Structure SyntaxTree
	*root.SyntaxTreeNode
	node.SyntaxTreeNode[#MAX_TREENODES]
	remark$ ;frei verwendbar
EndStructure





; *************************************************************************************
;{ Déclarations
Declare EnableConstantCalculation(bool.b)
Declare EnableFunctionCalculation(bool.b)
Declare.i GetCalculationError()
Declare.d CalculateD(expression$)
Declare.f CalculateF(expression$)
Declare.q CalculateQ(expression$)
Declare.i CalculateI(expression$)
Declare.l CalculateL(expression$)
Declare.q CalculateSyntaxTreeL(*tree.SyntaxTree)
Declare.d CalculateSyntaxTreeF(*tree.SyntaxTree)
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$)
Declare Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
Declare Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.i)
Declare.d Calc_GetNodeValue(*node.SyntaxTreeNode)
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.i, *nodeInsert.SyntaxTreeNode)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
Declare.s Calc_GetContent(*expression, type.i, *pos.Integer)
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode)
Declare.q Calc_Modulo(a.q, b.q)
;}
EnableFunctionCalculation(1)
EnableConstantCalculation(1)

; *************************************************************************************

Procedure.q Calc_Modulo(a.q, b.q)
	ProcedureReturn a - a / b * b
EndProcedure

Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode)
	Shared priorMod.q
	
	While PeekB(@operand$) = 41 ;Left(operand$, 1) = ")"
		operand$ = Mid(operand$, 2, Len(operand$))
		priorMod - #PRIORITY_STEP
	Wend
	
	While PeekB(@operand$ + Len(operand$) - 1) = 40 ;Right(operand$, 1) = "("
		operand$ = Left(operand$, Len(operand$) - 1)
		changePrior.q + #PRIORITY_STEP
	Wend
	
	Select operand$
		Case "+"
			*node\operand = #OP_PLUS
			*node\prior = priorMod + 1
		Case "-"
			*node\operand = #OP_MINUS
			*node\prior = priorMod + 1
		Case "*"
			*node\operand = #OP_MULT
			*node\prior = priorMod + 2
		Case "/"
			*node\operand = #OP_DIV
			*node\prior = priorMod + 2
		Case "^"
			*node\operand = #OP_POT
			*node\prior = priorMod + 3
			
			
		Case "~"
			*node\operand = #OP_FUNC
			;ACHTUNG: Funktionen müssen IMMMER die höchste Priorität besitzen
			*node\prior = priorMod + 4
		Default
			*node\operand = #OP_UNKNOWN
	EndSelect
	
	priorMod + changePrior
EndProcedure

Procedure.s Calc_GetContent(*expression, type.i, *pos.Integer)
	*pointer.Byte = *expression + *pos\i
	
	If type = #VALUE
		;(-x) Ausrdrücke zulassen
		If PeekB(*pointer) = 45 ; '-'
			*pointer + 1
		EndIf
		
		;) + - * / ^ ~ \0
		;Ascii-Wert eines neuen Operators hier mit einfügen
		While (*pointer\b < 97 Or *pointer\b > 122) And *pointer\b <> 41 And *pointer\b <> 42 And *pointer\b <> 43  And *pointer\b <> 45 And *pointer\b <> 47 And *pointer\b <> 94 And *pointer\b <> 126 And *pointer\b <> 0
			*pointer + 1
		Wend
	Else
		;0-9 .
		While (*pointer\b < 48 Or *pointer\b > 57) And *pointer\b <> 46 And *pointer\b <> 0
			*pointer + 1
		Wend
		;(-x) Ausrdrücke zulassen
		If PeekB(*pointer - 1) = 45 And PeekB(*pointer - 2) = 40 ; '(-'
			*pointer - 1
		EndIf
	EndIf
	
	a_RET$ = PeekS(*expression + *pos\i, (*pointer - *expression) - *pos\i)
	
	If *pointer\b
		*pos\i = *pointer - *expression
	Else
		*pos\i = -1
	EndIf
	
	ProcedureReturn a_RET$
EndProcedure

Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode)
	Protected child.i
	
	If *nodeTarget\parent
		If *nodeTarget\parent\child[0] = *nodeTarget
			child = 0
		ElseIf *nodeTarget\parent\child[1] = *nodeTarget
			child = 1
		EndIf
		*nodeTarget\parent\child[child] = *nodeInsert
		*nodeInsert\parent = *nodeTarget\parent
	EndIf
	*nodeTarget\parent = *nodeInsert
	*nodeInsert\child[0] = *nodeTarget
EndProcedure

Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.i, *nodeInsert.SyntaxTreeNode)
	If *nodeTarget\child[child]
		*nodeChild.SyntaxTreeNode = *nodeTarget\child[child]
		*nodeChild\parent = *nodeInsert
		*nodeInsert\child[0] = *nodeTarget\child[child]
	EndIf
	
	*nodeTarget\child[child] = *nodeInsert
	*nodeInsert\parent = *nodeTarget
EndProcedure

Procedure.d Calc_GetNodeValue(*node.SyntaxTreeNode)
	Shared calculationErrorOccured.b
	Result.d
	
	If *node
		If *node\operand
			valueOne.d = Calc_GetNodeValue(*node\child[0])
			valueTwo.d = Calc_GetNodeValue(*node\child[1])
			Select *node\operand
				Case #OP_PLUS
					Result = valueOne + valueTwo
				Case #OP_MINUS
					Result = valueOne - valueTwo
				Case #OP_MULT
					Result = valueOne * valueTwo
				Case #OP_DIV
					Result = valueOne / valueTwo
					If valueTwo = 0 And calculationErrorOccured = 0
						calculationErrorOccured = #CALC_ERR_DIVNULL
					EndIf
				Case #OP_POT
					Result = Pow(valueOne, valueTwo)
					
				Case #OP_FUNC
					Select valueOne ;steht für den Funktionstyp
						Case #FUNC_SQR
							Result = Sqr(valueTwo)
						Case #FUNC_SIN
							Result = Sin(valueTwo)
						Case #FUNC_ASIN
							Result = ASin(valueTwo)
						Case #FUNC_COS
							Result = Cos(valueTwo)
						Case #FUNC_ACOS
							Result = ACos(valueTwo)
						Case #FUNC_TAN
							Result = Tan(valueTwo)
						Case #FUNC_ATAN
							Result = ATan(valueTwo)
						Case #FUNC_INT
							Result = IntQ(valueTwo)
						Case #FUNC_ABS
							Result = Abs(valueTwo)
						Case #FUNC_LOG10
							Result = Log10(valueTwo)
						Case #FUNC_LOG
							Result = Log(valueTwo)
						Default
							calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND
					EndSelect
					
				Case #OP_UNKNOWN
					calculationErrorOccured = #CALC_ERR_OPNOTFOUND
			EndSelect
			ProcedureReturn Result
		Else
			ProcedureReturn *node\Value
		EndIf
	Else
		calculationErrorOccured = 1
	EndIf
EndProcedure

Procedure Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.i)
	;für Debugging und Veranschaulischungszwecke
	Shared isFunction.b
	
	If *node
		
		If  *node\operand
			If *node\operand = #OP_PLUS
				PrintN(Space(level * 2) + "+")
			ElseIf *node\operand = #OP_MINUS
				PrintN(Space(level * 2) + "-")
			ElseIf *node\operand = #OP_MULT
				PrintN(Space(level * 2) + "*")
			ElseIf *node\operand = #OP_DIV
				PrintN(Space(level * 2) + "/")
			ElseIf *node\operand = #OP_POT
				PrintN(Space(level * 2) + "^")
			ElseIf *node\operand = #OP_FUNC
				isFunction = 1
			EndIf
		Else
			If isFunction
				Print(Space((level-1) * 2))
				Select *node\Value
					Case #FUNC_SQR
						PrintN("SQR")
					Case #FUNC_SIN
						PrintN("SIN")
					Case #FUNC_ASIN
						PrintN("ASIN")
					Case #FUNC_COS
						PrintN("COS")
					Case #FUNC_ACOS
						PrintN("ACOS")
					Case #FUNC_TAN
						PrintN("TAN")
					Case #FUNC_ATAN
						PrintN("ATAN")
					Case #FUNC_INT
						PrintN("INT")
					Case #FUNC_ABS
						PrintN("ABS")
					Case #FUNC_LOG10
						PrintN("LOGTEN")
					Case #FUNC_LOG
						PrintN("LOG")
				EndSelect
			Else
				PrintN(Space(level * 2) + StrF(*node\Value))
			EndIf
		EndIf
		
		If *node\child[0]
			Calc_ConsoleOutSyntaxNode(*node\child[0], level + 1)
			isFunction = 0
		EndIf
		If *node\child[1]
			Calc_ConsoleOutSyntaxNode(*node\child[1], level + 1)
		EndIf
	EndIf
EndProcedure

Procedure Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree)
	;für Debugging und Veranschaulischungszwecke
	Calc_ConsoleOutSyntaxNode(*tree\root, 0)
EndProcedure

;--    Public

Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$)
	Shared priorMod.q, functionCalculationEnabled.b, constantCalculationEnabled.b
	
	priorMod = 0
	nodeCount.i = 0
	Position.i = 0
	
	*nodeLastValue.SyntaxTreeNode
	*nodeCurrentValue.SyntaxTreeNode
	*nodeLastOperand.SyntaxTreeNode
	*nodeCurrentOperand.SyntaxTreeNode
	
	expression$ = LCase(ReplaceString(expression$, " ", ""))
	
	While Left(expression$, 1) = "("
		expression$ = Mid(expression$, 2, Len(expression$))
		priorMod + #PRIORITY_STEP
	Wend
	While Right(expression$, 1) = ")"
		expression$ = Left(expression$, Len(expression$) - 1)
	Wend
	
	If functionCalculationEnabled
		expression$ = ReplaceString(expression$, "sqr",   Str(#FUNC_SQR) + "~")
		expression$ = ReplaceString(expression$, "asin",  Str(#FUNC_ASIN) + "~")
		expression$ = ReplaceString(expression$, "sin",   Str(#FUNC_SIN) + "~")
		expression$ = ReplaceString(expression$, "acos",  Str(#FUNC_ACOS) + "~")
		expression$ = ReplaceString(expression$, "cos",   Str(#FUNC_COS) + "~")
		expression$ = ReplaceString(expression$, "atan",  Str(#FUNC_ATAN) + "~")
		expression$ = ReplaceString(expression$, "tan",   Str(#FUNC_TAN) + "~")
		expression$ = ReplaceString(expression$, "int",   Str(#FUNC_INT) + "~")
		expression$ = ReplaceString(expression$, "abs",   Str(#FUNC_ABS) + "~")
		expression$ = ReplaceString(expression$, "log",Str(#FUNC_LOG10) + "~")
		expression$ = ReplaceString(expression$, "ln",   Str(#FUNC_LOG) + "~")
	EndIf
	
	If constantCalculationEnabled
		expression$ = ReplaceString(expression$, "pi", #CONST_PI)
		expression$ = ReplaceString(expression$, "e",  #CONST_E)
	EndIf
	
	;Debug expression$
	
	Repeat
		nodeCount + 1
		
		If Calc_Modulo(nodeCount, 2) ;Wert
			node$ = Calc_GetContent(@expression$, #VALUE, @Position)
			*tree\node[nodeCount]\Value = ValF(node$)
			*nodeCurrentValue = *tree\node[nodeCount]
			;Debug node$
			
			If nodeCount > 1
				Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue)
			EndIf
			
			*nodeLastValue = *nodeCurrentValue
		Else ;Operator
			node$ = Calc_GetContent(@expression$, #OPERAND, @Position)
			Calc_SetOperand(node$, *tree\node[nodeCount])
			
			*nodeCurrentOperand = *tree\node[nodeCount]
			;Debug node$ + " :: " + Str(*nodeCurrentOperand\prior)
			
			If *nodeLastOperand
				If *nodeCurrentOperand\prior > *nodeLastOperand\prior
					Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand)
				ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior
					Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand)
				Else
					*node.SyntaxTreeNode = *nodeLastOperand
					While *node\parent And *node\prior > *nodeCurrentOperand\prior
						*node = *node\parent
					Wend
					
					If *node\prior = *nodeCurrentOperand\prior
						Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
					ElseIf *node\prior < *nodeCurrentOperand\prior
						Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand)
					Else
						Calc_InsertNodeAsParent(*node, *nodeCurrentOperand)
					EndIf
				EndIf
			Else
				Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand)
			EndIf
			
			*nodeLastOperand = *nodeCurrentOperand
		EndIf
		
	Until Position = -1
	
	If *nodeLastOperand
		While *nodeLastOperand\parent
			*nodeLastOperand = *nodeLastOperand\parent
		Wend
		*tree\root = *nodeLastOperand
	ElseIf nodeCount = 1
		*tree\root = *nodeLastValue
	Else
		*tree\root = 0
	EndIf
	
EndProcedure

Procedure.d CalculateSyntaxTreeF(*tree.SyntaxTree)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	If *tree\root
		Result.d = Calc_GetNodeValue(*tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
		Result.d = 0 / Result
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.q CalculateSyntaxTreeL(*tree.SyntaxTree)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	If *tree\root
		Result.q = Calc_GetNodeValue(*tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.l CalculateL(expression$)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	tree.SyntaxTree
	CreateSyntaxTree(@tree, expression$)
	
	If tree\root
		Result.l = Calc_GetNodeValue(tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.i CalculateI(expression$)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	tree.SyntaxTree
	CreateSyntaxTree(@tree, expression$)
	
	If tree\root
		Result.i = Calc_GetNodeValue(tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.q CalculateQ(expression$)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	tree.SyntaxTree
	CreateSyntaxTree(@tree, expression$)
	
	If tree\root
		Result.q = Calc_GetNodeValue(tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.f CalculateF(expression$)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	tree.SyntaxTree
	CreateSyntaxTree(tree, expression$)
	
	If tree\root
		;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden
		Shared outputSyntaxTree.b
		If outputSyntaxTree
			Calc_ConsoleOutSyntaxTree(tree)
		EndIf
		
		Result.f = Calc_GetNodeValue(tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
		Result.f = 0 / Result
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.d CalculateD(expression$)
	Shared calculationErrorOccured.b
	calculationErrorOccured = 0
	
	tree.SyntaxTree
	CreateSyntaxTree(tree, expression$)
	
	If tree\root
		;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden
		Shared outputSyntaxTree.b
		If outputSyntaxTree
			Calc_ConsoleOutSyntaxTree(tree)
		EndIf
		
		Result.d = Calc_GetNodeValue(tree\root)
	Else
		;Fehler auslösen
		calculationErrorOccured = 1
		Result.d = 0 / Result
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.i GetCalculationError()
	Shared calculationErrorOccured.b
	ProcedureReturn calculationErrorOccured
EndProcedure

Procedure EnableFunctionCalculation(bool.b)
	Shared functionCalculationEnabled.b
	functionCalculationEnabled = bool
EndProcedure

Procedure EnableConstantCalculation(bool.b)
	Shared constantCalculationEnabled.b
	constantCalculationEnabled = bool
EndProcedure

Debug CalculateQ("cos(pi)")
Debug GetCalculationError()

Re: Tester une expression régulière

Publié : sam. 12/déc./2009 17:26
par dayvid
quoi c'est sa ta configuration solda inconnue ?:

Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, Windows XP

non d'un chien, qu'elle bourrain ce type :?

j'suis vert comme une pomme mois la 8O

et ba t'y va pas de main morte toi dit donc :mrgreen:

la vache :|
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru