PureBasic

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

Calculatrice avec priorité récursive

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

Page 1 sur 1

Calculatrice avec priorité récursive

Publié : jeu. 09/août/2012 15:57
par Golfy
Ce code de calculatrice est certainement encore bogué (bugger ? bugué ?) mais il illustre la récursivité sous purebasic et un algorithme de calculatrice (ainsi que le traitement de la touche [Entrée] dans une fenêtre).
Les fonctions %, Sin, etc. ne sont pas traitées et je ne pense pas le réaliser (je suis sur mon projet domotique) mais quand j'ai retrouvé ce vieux code qui ne marchait pas, je n'ai pas pu m'empêcher d'essayer de trouver une solution (pour ne pas rester sur un échec 8) )...
Donc avis aux améliorateurs :wink:

Code : Tout sélectionner

; PureBasic Visual Designer v3.93 build 1480 (PB4Code)

;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #String_0
  #String_1
  #Listview_0
  #Listview_1
  #Button_0
EndEnumeration

; My constant
#CLAVIER_RETURN = 15

Procedure Open_Window_0()
	If OpenWindow(#Window_0, 223, 6, 153, 41, "Euro'G 2.0 (beta1)", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
    StringGadget(#String_0, 0, 0, 125, 20, "")
    GadgetToolTip(#String_0, "Champ de saisie initiale")
    StringGadget(#String_1, 0, 20, 125, 20, "0",#PB_String_ReadOnly)
    GadgetToolTip(#String_1, "Champ de valeur convertie")
    ButtonGadget(#Button_0, 130, 0, 20, 20, "?")
  EndIf
EndProcedure

Procedure.s ChercheOperation(Texte$)
	operation$="+-*x/:%"
	If Len(Texte$)
		oldposition = Len(Texte$)
		For t=1 To Len(operation$)
			o$=Mid(operation$,t,1)
			position=FindString(Texte$,o$,1)
			If position<oldposition And position > 0
				oldposition = position
			EndIf
		Next t
		If oldposition < Len(Texte$)
			op$ = Mid(Texte$,oldposition,1)
			ProcedureReturn op$
		EndIf
	EndIf
	
	ProcedureReturn ""
EndProcedure

Procedure.d Calc(Texte$)
	Protected A$, B$, op$
	Protected resultat.d
	; 1 - on recherche un symbole d'opération

	If Len(Texte$)
		op$=ChercheOperation(Texte$)
		; S'il y a une opération
		If op$>""
			; je connais : A - operation - B
			;CallDebugger
			A$ = StringField(Texte$,1,op$)
			B$ = RemoveString(Texte$, A$+op$, #PB_String_CaseSensitive, 1, 1)
	
			Debug Str(level)+":  "+texte$+" -> ["+A$+"]"+op$+"["+B$+"]"
			If B$ > "" And ChercheOperation(Right(B$,1))=""
				Select op$
					Case "+"
						Resultat = ValF(A$) + Calc(B$)
					Case "-"
						Resultat = ValF(A$) - Calc(B$)
					Case "*", "x"
						C$ = StringField(B$,1,ChercheOperation(B$))
						B$ = RemoveString(B$, C$+op$, #PB_String_CaseSensitive, 1, 1)
						resultat.d = ValD(A$) * ValF(C$)
						resultat.d = Calc(StrD(resultat)+b$)
						
					Case "/", ":"
						If calc(b$) = 0
							resultat.d = 9e+9
						Else
							C$ = StringField(B$,1,ChercheOperation(B$))
							B$ = RemoveString(B$, C$+op$, #PB_String_CaseSensitive, 1, 1)
							resultat.d = ValD(A$) / ValD(C$)
							resultat.d = Calc(StrD(resultat)+b$)
						EndIf
						
					Case "%"
					Case "s","S"
						Resultat = Sin(Val(A$))
				EndSelect
				ProcedureReturn Resultat
			EndIf
		Else
			If op$="" And Texte$>""
				Debug Texte$+" = Fin de récursivité"
				ProcedureReturn ValD(Texte$)
			EndIf
		EndIf
	EndIf
EndProcedure

	
	
Open_Window_0()
AddKeyboardShortcut(0, #PB_Shortcut_Return,#CLAVIER_RETURN)
SetActiveGadget(#String_0)

Repeat
	EventID = WaitWindowEvent()
	If EventID = #PB_Event_Menu
		Evnt = EventMenu()
		If Evnt = #CLAVIER_RETURN
			Valeur.d = Calc(GetGadgetText(#String_0))
		EndIf
	EndIf
	
	If EventID = #PB_Event_Gadget
		Select EventGadget()
			Case #String_0
				Debug "--------------------------------------"
				Valeur.d = Calc(GetGadgetText(#String_0))		
			;If Int(ValD(GetGadgetText(#String_1))) = ValD(GetGadgetText(#String_1))
			;  SetGadgetText(#String_1,Str(Valeur))
			;Else
				v$=RTrim(RTrim(StrD(valeur.d),"0"),".")
			  SetGadgetText(#String_1,v$)
			;EndIf
		EndSelect
	EndIf
Until EventID = #PB_Event_CloseWindow

Re: Calculatrice avec priorité récursive

Publié : jeu. 09/août/2012 16:13
par G-Rom
marche pas avec les parenthèses, un allemand avait sorti une fonction eval(string$) , qui marche du tonnerre. ;)

Re: Calculatrice avec priorité récursive

Publié : jeu. 09/août/2012 16:29
par Backup
le meilleur code que je connaisse pour faire ça c'est :
celui-ci

Note :

il reconnait les termes
"sqr"
"asin"
"sin"
"acos"
"cos"
"atan"
"tan"
"int"
"abs"
"log"
"ln"

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)
; *************************************************************************************
; Mise en Action :
Debug CalculateQ("cos(pi)+4*156")  ;  <<<<<< on va effectuer ce calcul 
Debug GetCalculationError()
;
; *************************************************************************************

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

; EPB

Re: Calculatrice avec priorité récursive

Publié : jeu. 09/août/2012 17:43
par Golfy
G-Rom a écrit :marche pas avec les parenthèses, un allemand avait sorti une fonction eval(string$) , qui marche du tonnerre. ;)
Comme je l'ai dit, c'est une calculatrice simple : + - * /
L'idée n'est pas de faire une vraie calculatrice (j'aurais utilisé une pile, une liste chainée ou un truc comme ça) mais plutôt d'utiliser une procédure récursive !
Déjà, je me suis creusé la tête :x pour lire correctement les opérations et respecter les priorités... ensuite mon code est un peu plus court (132 lignes avec les espaces et commandes debug).

Donc j'ai juste publié pour que cela puisse servir un jour à quelqu'un : mais si quelqu'un veut l'améliorer ou s'en servir dans une appli, pas de problème :)

Re: Calculatrice avec priorité récursive

Publié : ven. 10/août/2012 9:12
par Golfy
OK j'avais dis que je n'y toucherai plus mais une suite d'opérations me "turlupinait" : -20+20 = 0 ou encore -5*-5 = -25 ! le programme ne savait pas prendre en compte le signe.

J'ai changé le 1 par un 2 dans la boucle ci-dessous :

Procedure.s ChercheOperation(Texte$)
operation$="+-*x/:%"
If Len(Texte$)
oldposition = Len(Texte$)
For t=2 To Len(operation$) ; nombre = 25 ou -25 : permet 5+-5=0
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru