"y = x + (z * 2) + (a * 3)"

1. reserviere Speicher für zwei Werte
2. multipliziere z mit 2 und speichere das Ergebnis an Position 1
3. multipliziere a mit 3 und speichere das Ergebnis an Position 2
4. addiere den Wert aus Position 1 mit x und speichere das Ergebnis in Position 1
5. addiere den Wert aus Position 1 mit dem Wert aus Position 2 und speichere das Ergebnis in Position 1
6. weise y den Wert aus Position 1 zu
7. fertig

z=MilliSecs()
Print rechnen("1+1*2+1")
Print MilliSecs()-z
WaitKey
End

Function rechnen(s$)

s$=Replace(s$," ","")
s$=Replace(s$,"--","+")
s$=Replace(s$,"++","+")
s$=Replace(s$,"---","-")
s$=Replace(s$,"+-","-")
s$=Replace(s$,"-+","+")

Repeat
If Instr(s$,"*") Then;Mal rechnen
pos=Instr(s$,"*")
zahl1=zahl1_herausfinden(pos,s$)
zahl2=zahl2_herausfinden(pos,s$)
zahl=zahl1*zahl2
s$=Replace(s$,zahl1+"*"+zahl2,zahl)
Else
Exit
EndIf
Forever
Repeat
If Instr(s$,"/") Then;Durch rechnen
pos=Instr(s$,"/")
zahl1=zahl1_herausfinden(pos,s$)
zahl2=zahl2_herausfinden(pos,s$)
zahl=zahl1/zahl2
s$=Replace(s$,zahl1+"/"+zahl2,zahl)
Else
Exit
EndIf
Forever

Repeat
If Instr(s$,"+") Then;Plus rechnen
pos=Instr(s$,"+")
zahl1=zahl1_herausfinden(pos,s$)
zahl2=zahl2_herausfinden(pos,s$)
zahl=zahl1+zahl2
s$=Replace(s$,zahl1+"+"+zahl2,zahl)
Else
Exit
EndIf
Forever

Repeat
If Instr(s$,"-") Then;Minus rechnen
pos=Instr(s$,"-")
zahl1=zahl1_herausfinden(pos,s$)
zahl2=zahl2_herausfinden(pos,s$)
WaitKey
zahl=zahl1-zahl2
s$=Replace(s$,zahl1+"-"+zahl2,zahl)
Else
Exit
EndIf
Forever
Return s


End Function

Function zahl2_herausfinden(pos,s$)
v=pos
b=pos+1
Repeat
v=v+1
b=b+1
z=Mid(s$,v,b-v)
If z=0 Then Exit
Select z
Case "+"
Exit
Case "-"
Exit
Case "*"
Exit
Case "/"
Exit
Case "^"
Exit
Case "("
Exit
Case ")"
Exit
End Select
Forever
v=v-1
b=b-1
zahl1#=Float(Mid(s$,v,b-v))
Return zahl1#
End Function

Function zahl1_herausfinden(pos,s$)
v=pos
b=pos-1
Repeat
v=v-1
b=b-1
If b=-1 Or v=0 Then Exit
z=Mid(s$,v,b-v)
Select z
Case "+"
Exit
Case "-"
Exit
Case "*"
Exit
Case "/"
Exit
Case "^"
Exit
Case "("
Exit
Case ")"
Exit
End Select
Forever
If v=0 Then
v=v+1
b=b+1
EndIf
zahl2#=Float(Mid(s$,v,b-v))
Return zahl2#
End Function

Graphics 800,600,32,2

Dim Memory(5000)
Dim OpName$(100)
Dim VarName$(5000),VarWert(5000)


OpName(1)="*"
OpName(2)="/"
OpName(3)="+"
OpName(4)="-"


Wert1=3
Wert2=4
Wert3=100
Wert4=2
Wert5=7
Wert6=8
Wert7=9

SetVar("Wert1",Wert1)
SetVar("Wert2",Wert2)
SetVar("Wert3",Wert3)
SetVar("Wert4",Wert4)
SetVar("Wert5",Wert5)
SetVar("Wert6",Wert6)
SetVar("Wert7",Wert7)
SetVar("Ergebnis",1)


Compelieren("Ergebnis=Wert1+Wert2+(Wert3+Wert6)*Wert4+Wert5")
Wert=(Wert1+Wert2+(Wert3+Wert6)*Wert4+Wert5)


PrgTimer=CreateTimer(60)
SetBuffer BackBuffer()


;Standartberechnung
  ZeitA=MilliSecs()
  For I=0 To 50000
  Wert=Wert1+Wert2+(Wert3+Wert6)*Wert4+Wert5
  Next:ZeitA=MilliSecs()-ZeitA
  Delay 100
 
;Meine berechnung
  ZeitB=MilliSecs()
  For I=0 To 50000:Rechnen():Next
  ZeitB=MilliSecs()-ZeitB
  AppTitle ZeitA+"   "+ZeitB

Erg=VarWert(FindVar("Ergebnis"))

Repeat
Wert5=Wert5+1
SetVar("Wert5",Wert5)
Cls

Rechnen()


Text 10,250,Wert
Text 10,300,VarWert(FindVar("Ergebnis"))


Flip 0:WaitTimer(PrgTimer)

Until KeyDown(1)=1
End

Function Rechnen()
   Local VarMemory[20000],Mem=4

   While Memory(Mem)<>0
      ZErg=Memory(Mem+0)
      AddA=Memory(Mem+1)
      AddB=Memory(Mem+3)
   
      If AddA>9999 WertA=VarMemory[AddA]
      If AddA<10000 WertA=VarWert(AddA)
      If AddB>9999 WertB=VarMemory[AddB]
      If AddB<10000 WertB=VarWert(AddB)
   
      Select Memory(Mem+2)
         Case 42 VarMemory[ZErg]=WertA*WertB
         Case 47 VarMemory[ZErg]=WertA/WertB
         Case 43 VarMemory[ZErg]=WertA+WertB
         Case 45 VarMemory[ZErg]=WertA-WertB
      End Select:Mem=Mem+4       
 
   Wend:VarWert(Memory(0))=VarMemory[ZErg]
End Function



Function VarErsetzen$(Term$)
   L=Len(Term)
   For I=0 To L:St$=Mid(Term,I+1,1)
      Select St:Case ")" Kl$=Kl$+St
         Case "(" NTerm$=NTerm+ST:P=P+1 
         Case "=","+","-","*","/"," "
         V$=Replace(Mid(Term,P+1,I-P),")"," ")
         NTerm=NTerm+Right("00000"+FindVar(V),5)
         NTerm=NTerm+Kl+St:Kl="":If St<>")" P=I+1
      End Select
   Next:Return NTerm
End Function

Function Compelieren(Term$)
   Local NAdd=10001,Mem=4
 
   Term=Replace(Term,"=","=(")+") "
   Term=VarErsetzen(Term):Memory(0)=Left(Term,5)
 
   Repeat:P=0
      Repeat:P=I:I=Instr(Term,"(",I+1):Until I=0
      If P=0 Then Return Term
      OTTerm$=Mid(Term,P+1,Instr(Term,")",P)-P-1)
      TTerm$=OTTerm:OpZa=1

      Repeat
         OpN$=OpName(OpZa) If OpN$="" Then Exit
         P=Instr(TTerm,OpN):If P=0 Then OpZa=OpZa+1
   
         If P<>0 Then
            WertA$=Mid(TTerm,P-5,5):WertB$=Mid(TTerm,P+1,5)
            Memory(Mem)=NAdd:Memory(Mem+1)=Int(WertA)
            Memory(Mem+2)=Asc(OpN$):Memory(Mem+3)=Int(WertB)
         
            ATerm$=Right("00000"+NAdd,5):Mem=Mem+4:NAdd=NAdd+1
            TTerm=Replace(TTerm,WertA+OpN$+WertB,ATerm)
         End If
      Forever
      Term=Replace(Term,"("+OTTerm+")",TTerm)
   Forever

   Return Term
End Function

 

Function FindVar(Name$)
   Name$=Trim(Name)
   While VarName(Add+1)<>"":Add=Add+1   
      If Name=VarName(Add) Return Add 
   Wend   
End Function

Function SetVar(Name$,Wert)
   While VarName(Add+1)<>""
   If Name=VarName(Add+1) VarWert(Add+1)=Wert:Return 
   Add=Add+1:Wend
   VarName(Add+1)=Name
   VarWert(Add+1)=Wert
End Function