Strings berechnen (Auch "Eval" genannt)

Josef Sniatecki · Beitrag von **Josef Sniatecki** » 16.07.2008 20:16

Hallo,

ich habe hier eines meiner Templates gepostet.
In dieser Datei sind schon alle wichtigen Dinge wie Erklärungen und
Beispiele vorhanden.

Code: Alles auswählen

;/-----------------------------------------------------------------\
;|  *** Calculate string - template ***                            |
;|    Created by Josef Sniatecki 2008.                             |
;\-----------------------------------------------------------------/

;  Durch "CalculateString" kann man einfache Stringterme
;  berechnen lassen. Die Werte werden in Doubles berechnet.
;  Dies erlaubt das Ausrechnen von komplexen Eingaben
;  wärend dem Programmablauf.
;  
;  FEATURES:
;    > Die Priorität kann durch Klammern erhöht werden.
;    > Die Priorität der Operatoren wird beachtet. (Punkt vor Strich usw.)
;    > Funktionen und Konstanten werden unterstützt. Sie können
;      auch selbst welche hinzufügen.
;    > Zahlen können auch im Binär- und Hexadezimalformat geschrieben werden.
;    > Logische Operatoren (wie &,|,! usw.) können genutzt werden.
;    > Variable Werte können leicht inerhalb eines Terms genutzt werden.
;      Mehr dazu unter "SYNTAX".
;    > Der Hoch-Operator ("^") kann genutzt werden.
;    > Leerzeichen in manchen Bereichen sind erlaubt.
;  
;  SYNTAX:
;    KOMMA:
;      Ein Komma wird immer durch einen "." gekennzeichnet.
;    FUNKTIONEN:
;      Funktionen können klein oder groß geschrieben werden.
;      Parameter werden in einer nachfolgenden Klammer gesetzt
;      und durch ein "," getrennt. Die Klammern müssen auch
;      bei keinen Parametern vorkommen.
;    KONSTANTEN:
;      Konstanten werdem wie in PureBasic mit einem "#"
;      angefangen und können klein oder groß geschrieben werden.
;    VARIABLEN:
;      Variablen müssen immer ein einzelner Buchstabe sein.
;      Dieser kann klein oder groß sein; jedoch macht
;      die größe keinen Unterschied. Um einer Variable
;      einen Wert zu setzen, kann man folgende Wege nutzen:
;      > CalcStr_Var('GROßBUCHSTABE'-65)=WERT
;      > CalcStr_Var('KLEINBUCHSTABE'-97)=WERT
;    BINÄR:
;      Binärzahlen werden mit einem "%" gestartet. Dabei können
;      die nachfolgenden Binärzeichen folgende sein:
;      > 1 = 1,i,I
;      > 0 = 0,o,O
;    HEXADEZIMAL:
;      Hexadezimalzahlen werden mit einem "$" gestartet.
;      Die nachfolgenden Buchstaben können klein oder groß
;      geschrieben werden.



CompilerIf Defined(Templates_Math_CalculateString_PBI,#PB_Constant)=#False
#Templates_Math_CalculateString_PBI=#True



;/------------------------------------------\
;| Intergrations                            |
;\------------------------------------------/

; CompilerIf Defined(Templates_Default_PB,#PB_Constant)=#False
;   IncludePath "C:\Dokumente und Einstellungen\JOSEF SNIATEZKY\Eigene Dateien\Entwicklung\PureBasic\Templates\"
;   IncludeFile "Default.pb"                   ;Mein alter name :)
; CompilerEndIf
; 
; IncludeFile "Default\Macros.pbi"
; IncludeFile "Default\Constants.pbi"
; IncludeFile "Math\Default.pbi"

;Von einem Template von mir hineinkopiert:
Procedure.l DBin(Bin.s)
  ;DecimalBinary(Binary)
  
  Protected *Char.Character ;Character
  Protected I.l             ;Index
  Protected Dec.l           ;Decimal
  
  *Char=@Bin
  While *Char\C<>0
    Dec<<1
    If *Char\C='1' : Dec+1 : EndIf
    *Char+1
  Wend
  ProcedureReturn Dec
EndProcedure
Procedure.l DHex(Hex.s)
  ;DecimalHexadecimal(Hex)
  
  Protected *Char.Character ;Character
  Protected I.l             ;Index
  Protected Dec.l           ;Decimal
  
  *Char=@Hex
  While *Char\C<>0
    Dec<<4
    If *Char\C<='9' : Dec+*Char\C-'0' : Else : Dec+*Char\C-'A'+10 : EndIf
    *Char+1
  Wend
  ProcedureReturn Dec
EndProcedure



;/------------------------------------------\
;| Constants                                |
;\------------------------------------------/

Enumeration 0  ;CalculateString_Priorities
  #CalcStr_AddASubPrio ;AddAndSubtract~
  #CalcStr_MulADivPrio ;MultiplicateAndDivide~
  #CalcStr_LogicalPrio
  #CalcStr_PowPrio     ;Power~
  #CalcStr_NotPrio
EndEnumeration



;/------------------------------------------\
;| Variables                                |


;\------------------------------------------/

Global *CalcStr_CChar.Character=0 ;CalculateString_CurrentCharacter
Global CalcStr_Prio.b             ;~Priority
Global Dim CalcStr_Var.d(25)      ;~Variable
Global *CalcStr_FuncA             ;~FunctionArray
Global *CalcStr_FuncA_End.l       ;~FunctionArray_End
Global *CalcStr_ConstA            ;~ConstantArray
Global *CalcStr_ConstA_End.l      ;~ConstantArray_End



;/------------------------------------------\
;| Declarings                               |
;\------------------------------------------/

Declare.d CalcStr(Term.s="",Prio.b=0)
Declare.d CalcStr_Num()
Declare.d CalcStr_Bin()
Declare.d CalcStr_Hex()
Declare.d CalcStr_Func()
Declare.l CalcStr_Args(ArgAm.l)
Declare.d CalcStr_Const()



;/------------------------------------------\
;| Functions                                |
;\------------------------------------------/

Procedure.d CalcStr(Term.s="",Prio.b=0)
  ;CalculateString(Term="",Priority=0)
  
  #CalcStr_InvChar=0 ;~InvaildCharacter
  
  Protected Num.d ;Number
  Protected L1.l  ;Long1
  Protected L2.l  ;Long2
  
  If Term ;Neuer Term.
    *CalcStr_CChar=@Term
  EndIf
  
  While *CalcStr_CChar\C<>0
    Select *CalcStr_CChar\C
      Case '0' To '9'
        Num=CalcStr_Num()
      Case '%' ;Binär
        *CalcStr_CChar+1
        Num=CalcStr_Bin()
      Case '$' ;Hexadezimal
        *CalcStr_CChar+1
        Num=CalcStr_Hex()
      Case 'A' To 'Z','a' To 'z'
        Select PeekC(*CalcStr_CChar+1)
          Case 'A' To 'Z','a' To 'z' ;Funktion
            Num=CalcStr_Func()
            *CalcStr_CChar+1
            Continue
          Default ;Variable
            If *CalcStr_CChar<=90
              Num=CalcStr_Var(*CalcStr_CChar\C-65)
            Else
              Num=CalcStr_Var(*CalcStr_CChar\C-97)
            EndIf
        EndSelect
      Case '#' ;Konstante auslesen.
        *CalcStr_CChar+1
        Num=CalcStr_Const()
        
      Case '+'
        If Prio<=#CalcStr_AddASubPrio
          *CalcStr_CChar+1
          Num+CalcStr("",#CalcStr_AddASubPrio)
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '-'
        If Prio<=#CalcStr_AddASubPrio
          *CalcStr_CChar+1
          Num-CalcStr("",#CalcStr_AddASubPrio)
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '*'
        If Prio<=#CalcStr_MulADivPrio
          *CalcStr_CChar+1
          Num*CalcStr("",#CalcStr_MulADivPrio)
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '/'
        If Prio<=#CalcStr_MulADivPrio
          *CalcStr_CChar+1
          Num/CalcStr("",#CalcStr_MulADivPrio)
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '&'
        If Prio<=#CalcStr_LogicalPrio
          *CalcStr_CChar+1
          L1=Num
          L2=CalcStr("",#CalcStr_LogicalPrio)
          L1&L2
          Num=L1
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '|'
        If Prio<=#CalcStr_LogicalPrio
          *CalcStr_CChar+1
          L1=Num
          L2=CalcStr("",#CalcStr_LogicalPrio)
          L1|L2
          Num=L1
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '!'
        If Prio<=#CalcStr_LogicalPrio
          *CalcStr_CChar+1
          L1=Num
          L2=CalcStr("",#CalcStr_LogicalPrio)
          L1!L2
          Num=L1
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '^'
        If Prio<=#CalcStr_PowPrio
          *CalcStr_CChar+1
          Num=Pow(Num,CalcStr("",#CalcStr_PowPrio))
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
      Case '~'
        If Prio<=#CalcStr_NotPrio
          *CalcStr_CChar+1
          L1=CalcStr("",#CalcStr_NotPrio)
          L1=~L1
          Num=L1
          Prio=0
          Continue
        Else
          ProcedureReturn Num
        EndIf
        
      Case '°',248 ;Winkel in Bogenmaß umwandeln.
        Num=Num*2*#PI/360
      Case '²',253 ;²
        Num=Num*Num
      Case '³',252 ;³
        Num=Num*Num*Num
        
      Case '{' ;Durchschnitt.
        *CalcStr_CChar+1
        L1=0
        Repeat
          Num+CalcStr()
          L1+1
        Until *CalcStr_CChar\C='}' Or PeekC(*CalcStr_CChar-1)<>','
        Num/L1
      Case '}' ;Ende des Durchschnitts.
        ProcedureReturn Num
        
      Case ','
        *CalcStr_CChar+1
        ProcedureReturn Num
      Case '(' ;Neue Ebene hinzufügen.
        *CalcStr_CChar+1
        Num=CalcStr()
        *CalcStr_CChar+1
        Continue
      Case ')' ;Eine Ebene zurückspringen.
        ProcedureReturn Num
      Case ' ' ;Unnützliches Zeichen.
        *CalcStr_CChar+1
        Continue
        
      Default
        CompilerIf #PB_Compiler_Debugger
          Debug "CalcStr() error: "+Chr(32)+Chr(*CalcStr_CChar\C)+Chr(32)+" is an invaild character!"
          Beep_(250,250)
          End
        CompilerElse
          ; PushC(*CalcStr_CChar\C)
          ; Exception(@CalcStr(),#CalcStr_InvChar)
          ; *CalcStr_CChar\C=PopC()
          ; Continue
        CompilerEndIf
    EndSelect
    *CalcStr_CChar+1
  Wend
  ProcedureReturn Num
EndProcedure
Procedure.d CalcStr_Num()
  ;CalculateString_Number()
  
  Protected NumAStr.s ;NumberAsString
  
  Repeat
    Select *CalcStr_CChar\C
      Case '0' To '9','.'
        NumAStr+Chr(*CalcStr_CChar\C)
      Default
        *CalcStr_CChar-1
        ProcedureReturn ValD(NumAStr)
    EndSelect
    *CalcStr_CChar+1
  ForEver
  ProcedureReturn 0
EndProcedure
Procedure.d CalcStr_Bin()
  ;CalculateString_Binary()
  
  Protected NumAStr.s ;NumerAsString
  
  Repeat
    Select *CalcStr_CChar\C
      Case '0','1'
        NumAStr+Chr(*CalcStr_CChar\C)
      Case 'o','O'
        NumAStr+"0"
      Case 'i','I'
        NumAStr+"1"
      Default
        *CalcStr_CChar-1
        ProcedureReturn DBin(NumAStr)
    EndSelect
    *CalcStr_CChar+1
  ForEver
  ProcedureReturn 0
EndProcedure
Procedure.d CalcStr_Hex()
  ;CalculateString_Hexadecimal()
  
  Protected NumAStr.s ;NumerAsString
  
  Repeat
    Select *CalcStr_CChar\C
      Case '0' To '9','A' To 'F'
        NumAStr+Chr(*CalcStr_CChar\C)
      Case 'a' To 'f'
        NumAStr+UCase(Chr(*CalcStr_CChar\C))
      Default
        *CalcStr_CChar-1
        ProcedureReturn DHex(NumAStr)
    EndSelect
    *CalcStr_CChar+1
  ForEver
  ProcedureReturn 0
EndProcedure
Procedure.d CalcStr_Func()
  ;CalculateString_Function()
  
  #CalcStr_Func_InvFunc=0 ;~InvaildFunction
  #CalcStr_Func_InvChar=1 ;~InvaildCharacter
  
  Protected Func.s ;Function
  Protected Num.d  ;Number
  Protected *Args  ;Arguments
  Protected *Ptr   ;Pointer
  Protected F.b    ;Found
  
  Repeat
    Select *CalcStr_CChar\C
      Case 'A' To 'Z','a' To 'z'
        Func+Chr(*CalcStr_CChar\C)
      Case '('
        Func=LCase(Func)
        Select Func
          Case "abs"
            *Args=CalcStr_Args(1)
            Num=Abs(PeekD(*Args))
          Case "pow"
            *Args=CalcStr_Args(2)
            Num=Pow(PeekD(*Args),PeekD(*Args+SizeOf(Double)))
          Case "sqr"
            *Args=CalcStr_Args(2)
            Num=Pow(PeekD(*Args),1/PeekD(*Args+SizeOf(Double)))
          Case "arc","a"
            *Args=CalcStr_Args(1)
            Num=PeekD(*Args)*360/(2*#PI)
          Case "rad","r"
            *Args=CalcStr_Args(1)
            Num=PeekD(*Args)*2*#PI/360
          Case "sin"
            *Args=CalcStr_Args(1)
            Num=Sin(PeekD(*Args))
          Case "cos"
            *Args=CalcStr_Args(1)
            Num=Cos(PeekD(*Args))
          Case "tan"
            *Args=CalcStr_Args(1)
            Num=Tan(PeekD(*Args))
          Case "asin"
            *Args=CalcStr_Args(1)
            Num=ASin(PeekD(*Args))
          Case "acos"
            *Args=CalcStr_Args(1)
            Num=ACos(PeekD(*Args))
          Case "atan"
            *Args=CalcStr_Args(1)
            Num=ATan(PeekD(*Args))
            
          Default
            If *CalcStr_FuncA
              *Ptr=*CalcStr_FuncA
              While *Ptr<*CalcStr_FuncA_End
                If Func=PeekS(*Ptr)
                  *Ptr+Len(PeekS(*Ptr))+1
                  If PeekL(*Ptr)
                    *Args=CalcStr_Args(PeekL(*Ptr))
                  EndIf
                  *Ptr+SizeOf(Long)
                  CallFunctionFast(PeekL(*Ptr),*Args,@Num)
                  F=#True
                  Break
                Else
                  *Ptr+Len(PeekS(*Ptr))+1
                  *Ptr+SizeOf(Long)*2
                EndIf
              Wend
            EndIf
            
            If F=#False
              CompilerIf #PB_Compiler_Debugger
                Debug "CalcStr_Func() error: "+Func+" is an invaild function!"
                Beep_(250,250)
                End
              CompilerElse
                Push(Func)
                Exception(@CalcStr_Func(),#CalcStr_Func_InvFunc)
                Num=PopD()
              CompilerEndIf
            EndIf
        EndSelect
        If *Args : FreeMemory(*Args) : EndIf
        ProcedureReturn Num
      Default
        CompilerIf #PB_Compiler_Debugger
          Debug "CalcStr_Func() error: "+Str(*CalcStr_CChar\C)+" code is an invaild function character."
          Beep_(250,250)
          End
        CompilerElse
          ; PushC(*CalcStr_CChar\C)
          ; Exception(@CalcStr_Func(),#CalcStr_Func_InvChar)
          ; *CalcStr_CChar\C=PopC()
          ; Continue
        CompilerEndIf
    EndSelect
    *CalcStr_CChar+1
  ForEver
  ProcedureReturn 0
EndProcedure
Procedure.l CalcStr_Args(ArgAm.l)
  ;CalculateString_Arguments(ArgumentAmount)
  
  Protected *Args ;Arguments
  Protected I.l   ;Index
  
  *Args=AllocateMemory(SizeOf(Double)*ArgAm)
  *CalcStr_CChar+1
  
  For I=1 To ArgAm
    PokeD(*Args+SizeOf(Double)*(I-1),CalcStr())
  Next
  ProcedureReturn *Args
EndProcedure
Procedure.d CalcStr_Const()
  ;CalculateString_Constant()
  
  #CalcStr_InvConst=0 ;~InvaildConstant
  
  Protected Const.s ;Constant
  Protected Num.d   ;Number
  Protected *Ptr    ;Pointer
  Protected F.b     ;Found
  
  Repeat
    Select *CalcStr_CChar\C
      Case 'A' To 'Z','a' To 'z'
        Const+Chr(*CalcStr_CChar\C)
      Default
        *CalcStr_CChar-1
        Const=LCase(Const)
        Select Const
          Case "pi"
            Num=3.1415926535897931 ;Entspricht dem Double-Format.
          Case "eul","e"
            Num=2.7182818284590455 ;Entspricht dem Double-Format.
          Case "ang","a"           ;"Ang" entspricht "Angle"
            Num=57.2957795131
          Case "rad","r"
            Num=0.0174532925
          Default
            If *CalcStr_ConstA
              *Ptr=*CalcStr_ConstA
              While *Ptr<>*CalcStr_ConstA_End
                If Const=PeekS(*Ptr)
                  *Ptr+Len(PeekS(*Ptr))+1
                  Num=PeekD(*Ptr)
                  F=#True
                  Break
                Else
                  *Ptr+Len(PeekS(*Ptr))+1
                  *Ptr+SizeOf(Double)
                Endif
              Wend
            EndIf
            
            If F=#False
              CompilerIf #PB_Compiler_Debugger
                Debug "CalcStr_Const() error: "+Const+" is an invaild constant!"
                Beep_(250,250)
                End
              CompilerElse
                ; PushS(Const)
                ; Exception(@CalcStr_Const(),#CalcStr_InvConst)
                ; Num=PopD()
              CompilerEndIf
            EndIf
        EndSelect
        ProcedureReturn Num
    EndSelect
    *CalcStr_CChar+1
  ForEver
  ProcedureReturn 0
EndProcedure



;/------------------------------------------\
;| Examples                                 |
;\------------------------------------------/

;{ View
;   ;Dieses Beispiel zeigt einige möglichen Terme und erlaubt
;   ;selbst welche zu schreiben und ausrechnen zu lassen.
; 
;   OpenConsole()
;   ConsoleTitle("Term calculator")
;   
;   ConsoleColor(15,0) : PrintN("Example terms with their results:") : ConsoleColor(7,0)
;   PrintN("12.5 + 20.5      = "+StrD(CalcStr("12.5+20.5")))           ;Normale Dezimalrechnung.
;   PrintN("60 + 2 * 5       = "+StrD(CalcStr("60+2*5")))              ;Punkt vor Strich wird beachtet.
;   PrintN("sin(45"+Chr(248)+")         = "+StrD(CalcStr("Sin(45°)"))) ;Unterstützung von Funktionen.
;   PrintN("%10 | %01        = "+StrD(CalcStr("%10|%01")))             ;Binäre Berechnung.
;   PrintN("{20,10}          = "+StrD(CalcStr("{20,10}")))             ;Berechnung des Durchschnitts.
;   PrintN("#PI*2            = "+StrD(CalcStr("#PI*2")))               ;Ersetzt Konstanten.
;   
;   PrintN("")
;   ConsoleColor(15,0) : PrintN("You can also use functions:") : ConsoleColor(7,0)
;   PrintN("2 * x + 3 ^ (x / 2) + 5")
;   For X=1 To 5
;     CalcStr_Var('X'-65)=X
;     PrintN("x = "+Str(CalcStr_X)+"     : "+StrD(CalcStr("2*x+3^(x/2)+5")))
;   Next
;   PrintN("the variables can be the letters from a to z.")
;   
;   PrintN("")
;   ConsoleColor(15,0) : PrintN("Your own terms:") : ConsoleColor(7,0)
;   PrintN("1 - default")
;   PrintN("2 - function")
;   PrintN("Enter nothing to return.")
;   PrintN("")
;   
;   Repeat
;     ConsoleColor(12,0) : Print("Mode: ") : ConsoleColor(7,0)
;     Select Input()
;       Case "1"
;         Repeat
;           ConsoleColor(12,0) : Print("Term: ") : ConsoleColor(7,0)
;           Term$=Input()
;           If Term$
;             ConsoleColor(14,0) : Print("Result: ") : ConsoleColor(7,0)
;             PrintN(StrD(CalcStr(Term$)))
;           EndIf
;         Until Term$=""
;       Case "2"
;         ConsoleColor(12,0) : Print("Function: ") : ConsoleColor(7,0)
;         Function$=Input()
;         Repeat
;           ConsoleColor(12,0) : Print("x: ") : ConsoleColor(7,0)
;           X$=Input()
;           If X$
;             CalcStr_Var('X'-65)=CalcStr(X$) ;Setzt die Variable x auf den eingegebenen Wert.
;             ConsoleColor(14,0) : Print("Result: ") : ConsoleColor(7,0)
;             PrintN(StrD(CalcStr(Function$)))
;           EndIf
;         Until X$=""
;       Default
;         Break
;     EndSelect
;   ForEver
;   
;   CloseConsole()
;   End
;}
;{ Extended
;   ;In diesem Beispiel werden eigene Funktionen angewendet.
;   ;Alle Argumente werden in den Zeiger 'Args' abgespeichert.
;   ;Diese können dann mit 'PokeD' ausgelesen werden.
;   
;   Global Mem.d
;   
;   Procedure.l CalcStr_Func_Rand(*Args,*Num)
;     ;CalculateString_Function_Random(Arguments,Number)
;     
;     PokeD(*Num,Random(PeekD(*Args)))
;   EndProcedure
;   Procedure.l CalcStr_Func_Mem(*Args,*Num)
;     ;CalculateString_Function_Memory(Arguments,Number)
;     
;     PokeD(*Num,Mem)
;   EndProcedure
;   
;   DataSection
;     Funcs: ;Functions
;       Data.s "rand"               ;Name einer Funktion. Immer klein schreiben!
;       Data.l 1                    ;Anzahl der Argumente.
;       Data.l @CalcStr_Func_Rand() ;Zeiger auf die wahre Funktion.
;       
;       Data.s "mem"
;       Data.l 0
;       Data.l @CalcStr_Func_Mem()
;     EndFuncs: ;EndOfFunctions
;   EndDataSection
;   
;   *CalcStr_FuncA=?Funcs        ;Setzt den Anfangslabel für die eigenen Funktionen.
;   *CalcStr_FuncA_End=?EndFuncs ;Setzt das Endlabel für die eigenen Funktionen.
;   
;   
;   
;   OpenConsole()
;   ConsoleTitle("Term calculator")
;   
;   PrintN("1 - default")
;   PrintN("2 - function")
;   PrintN("Enter nothing to return.")
;   PrintN("")
;   
;   Repeat
;     ConsoleColor(12,0) : Print("Mode: ") : ConsoleColor(7,0)
;     Select Input()
;       Case "1"
;         Repeat
;           ConsoleColor(12,0) : Print("Term: ") : ConsoleColor(7,0)
;           Term$=Input()
;           If Term$
;             ConsoleColor(14,0) : Print("Result: ") : ConsoleColor(7,0)
;             Mem=CalcStr(Term$) ;Das Ergebnis wird in 'Mem' abgespeichert und kann mit "MEM()" wieder erhalten werden.
;             PrintN(StrD(Mem))
;           EndIf
;         Until Term$=""
;       Case "2"
;         ConsoleColor(12,0) : Print("Function: ") : ConsoleColor(7,0)
;         Function$=Input()
;         Repeat
;           ConsoleColor(12,0) : Print("x: ") : ConsoleColor(7,0)
;           X$=Input()
;           If X$
;             CalcStr_Var('X'-65)=CalcStr(X$) ;Setzt die Variable x auf den eingegebenen Wert.
;             ConsoleColor(14,0) : Print("Result: ") : ConsoleColor(7,0)
;             PrintN(StrD(CalcStr(Function$)))
;           EndIf
;         Until X$=""
;       Default
;         Break
;     EndSelect
;   ForEver
;   
;   CloseConsole()
;   End
;}



CompilerEndIf

Dieses Template kann komplexe Terme, die in einem String
beschrieben sind, berechnen. Dadurch sind Anwendereingaben
während dem Programmablauf möglich zu berechnen.
Im Code Archiv habe ich oftmals Evals gesehen, die entweder
sehr schnell sind (Mit ASM geproggt) oder sehr langsam sind
(String stück für Stück ersetzen). Doch meines ist keines
von beiden, da das String Zeichen für Zeichen durchgelesen wird
und kein ASM genutzt wird.

Probiert's doch einfach mal aus. Wenn ihr Vorschläge oder Bugs habt,
dann wäre ich euch sehr dankbar; Denn irgendwo könnte sich was
eingeschlichen haben, da ich den Code ganze 15 Mal (Habe ich gezählt

) überarbeiten musste, damit dieser endlich richtig funktioniert
hat!

STARGÅTE · Beitrag von **STARGÅTE** » 16.07.2008 20:40

Erst mal

Nun aber

Code: Alles auswählen

Debug CalcStr("1+1+1+1+1+1+1")
Debug CalcStr("1+1+1+1+1+1+1+1")
Debug CalcStr("1+1+1+1+1+1+1+1+1")

7.0
8.0
-1.#IND

PS: ich habe das getestet, weil ich auch mal diesen Fehler hatte.

Falls ich meine Lösung wieder finde, editiere ich diesen POST....

aber vllt findest du ja auch schon die Lösung

Josef Sniatecki · Beitrag von **Josef Sniatecki** » 16.07.2008 20:48

Hmm... Könnte wegen der rekursiven Berechnung sein.
Nach jedem Operator und nach jeder Klammer wird eine neue
Prozedur aufgerufen. Warscheinlich kommt nach 9 Mal Zurückgeben
einer Double-Zahl irgendein Fehler. Das könnte der einzige Grund
sein.
Jedoch müsste ich sehr viel ändern, um diesen Fehler zu beheben.

Ich bin mir nicht sicher, ob das deswegen ist.

STARGÅTE · Beitrag von **STARGÅTE** » 16.07.2008 20:57

Habe die Lösung nun bei mir gefunden:

wenn ich zB sowas gemacht habe :

Code: Alles auswählen

Ergebnis.d = Procedure(...) + Procedure(...)

kam es zu diesem Fehler.

Der fehler ging weg als ich es so machte:

Code: Alles auswählen

A.d = Procedure(...)
B.d = Procedure(...)
Ergebnis.d = A + B

ob das dir nun hilft weiß ich nicht...

Kaeru Gaman · Beitrag von **Kaeru Gaman** » 16.07.2008 21:01

scheint ein ähnliches problem wie "Expression too complex" bzw. "out of registers" zu sein,
der sich ebenfalls durch vorhertrennen bereinigen ließ.

Josef Sniatecki · Beitrag von **Josef Sniatecki** » 16.07.2008 21:04

@STARGATE:

Leider hilft mir das nicht.
Trotzdem danke.

Doch wieso

Code: Alles auswählen

Ergebnis.d = Procedure(...) + Procedure(...)

nicht funktioniert, ist mir ein Rätsel.

Little John · Beitrag von **Little John** » 16.07.2008 21:17

Josef Sniatecki hat geschrieben:Hmm... Könnte wegen der rekursiven Berechnung sein.
Nach jedem Operator und nach jeder Klammer wird eine neue
Prozedur aufgerufen. Warscheinlich kommt nach 9 Mal Zurückgeben
einer Double-Zahl irgendein Fehler. Das könnte der einzige Grund
sein.
Jedoch müsste ich sehr viel ändern, um diesen Fehler zu beheben.

Ich bin mir nicht sicher, ob das deswegen ist.

Code: Alles auswählen

CalcStr("1+1+1+1+1+1+1")

wird von Deinem Code rekursiv berechnet???
Normalerweise macht man das nicht und daher sollte es auch völlig egal sein, ob dort 7-mal oder 700-mal "+1" steht. Rekursion gibt nur dort Sinn, wo in der zu berechnenden Formel eine Funktion oder Operation höherer Priorität kommt, die zunächst berechnet werden soll, bevor dann mit dem Ergebnis davon "auf der ursprünglichen Ebene" weitergerechnet wird.
Insgesamt sieht Dein Code unnötig kompliziert aus.

Gruß, Little John

Josef Sniatecki · Beitrag von **Josef Sniatecki** » 16.07.2008 21:23

@Little John:

Hey, danke. Ich könnte bei
gleicher oder tieferer Priorität eines nächsten Operators die gleiche
Prozedur/Ebene beibehalten.

>> Insgesamt sieht Dein Code unnötig kompliziert aus.
Liegt wohl an den vielen Abkürzungen. Diese habe ich
jedoch mit dem vollen Namen kommentiert.
Ist halt mein Style. Ließ einfach mein Zitat.

Progge gerade mein Template um.

Josef Sniatecki · Beitrag von **Josef Sniatecki** » 16.07.2008 21:36

Josef Sniatecki hat geschrieben:Progge gerade mein Template um.

Habe gemerkt, dass ich das mit dem Beibehalten der gleichen Ebene
nur schwer realisieren kann.

Code: Alles auswählen

Case '+'
  If Prio<=#CalcStr_AddASubPrio
    *CalcStr_CChar+1
    Num+CalcStr("",#CalcStr_AddASubPrio) ;Hier ist der Harken.
    Prio=0
    Continue
  Else
    ProcedureReturn Num ;Eine Ebene zurückspringen.
  EndIf

Ich weiß nicht, wie ich sofort etwas zu "Num" addieren könnte, da
Konstanten, Klammern, Funktionen usw. nachfolgen könnten.
Die einzige Möglichkeit ist, alles Rekursiv zu bearbeiten. Eine andere
Möglichkeit sehe ich leider nicht.

Little John · Beitrag von **Little John** » 16.07.2008 21:59

Liegt wohl an den vielen Abkürzungen.

Nein, das liegt daran dass er nicht sauber logisch strukturiert ist.

Ich muss mal sehen, ob ich irgendwo noch alten Code finde. Ich kann das jetzt auch nicht "mal eben so" hinschreiben, dafür ist das zu viel und zu diffizil. Ist auch kein einfaches Thema. Den größten Gewinn hättest Du wahrscheinlich, wenn Du mal was zu dem Thema in einem guten Buch lesen würdest. Im Internet findet man vielleicht auch lehrreiche Texte. Du kannst mal nach rekursiv absteigendem Parser suchen.

Hier noch ein kleines Beispiel, wo der Einsatz von Rekursion nicht sinnvoll ist:

Code: Alles auswählen

Procedure.l Fakultaet_1 (n.l)
   If n = 0
      ProcedureReturn 1
   Else
      ProcedureReturn n * Fakultaet_1(n-1)
   EndIf
EndProcedure

Procedure.l Fakultaet_2 (n.l)
   Protected i.l, ret.l
   
   ret = 1
   For i = 2 To n
      ret * i
   Next
   ProcedureReturn ret
EndProcedure

Debug Fakultaet_1(3)
Debug Fakultaet_2(3)

Beide Funktionen berechnen korrekt die Fakultät, aber die erste, rekursive Funktion ist eigentlich nichts andere als eine "hübsch verpackte" For-Schleife.

Folgendes ist nicht böse gemeint, und ich hoffe Du bist es mir auch nicht.

Ich habe diesen Abschnitt "Code, Tipps und Tricks" eigentlich immer so verstanden, dass hier beispielhafter Code gepostet werden soll, den man mit entsprechendem Hintergrundwissen sorgfältig erarbeitet hat, und den andere nahezu "unbesehen" übernehmen können, und/oder der als Lehrbeispiel dienen kann. Um ehrlich zu sein, glaube ich nicht dass man das von Deinem obigen Code sagen kann. Das Thema ist aber auch nicht einfach.

Nichts für ungut, Little John