PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Strings mit SQLite berechnen

https://www.purebasic.fr/german/viewtopic.php?t=24235

Seite 2 von 2

Re: Strings mit SQLite berechnen

Verfasst: 07.05.2011 01:14
von STARGÅTE
String (bzw. allgemein: Ausdrücke) mit einer Datenbank-Enige berechnen zu lassen ist wirklich Trickreich, dass habe ich schon damals "bewundet".

Doch diese Methode sollte man wirklich nur "ab und zu" verwenden.
Führt man eine solche Funktion z.B. in einer Schleife aus, geht das Programm "relativ schnell" in die Knie.
Dort kommt man um einen "eigenen" Compiler nicht drum rum.

Trotzdem möchte ich in diesem Thema noch eine kleine Erweiterung bereitstellen.

Das ganze heißt bei mir Evaluator.
Mit diesem Include ist es möglich Ausdrücke berechnen zu lassen, und als erweiterung sogar Variablen zu benutzten, als Schnittstelle zwischen PB und dem Evaluator.
Dazu kann man EvaluatorEnvironment erstellen.

Code: Alles auswählen

; Konstanten

Enumeration 
   #Evaluator_VariableType_Integer
   #Evaluator_VariableType_Float
   #Evaluator_VariableType_String
EndEnumeration


; Strukturen

Structure EvaluatorVariable
   Type.i
   StructureUnion
      Integer.i
      Float.f
   EndStructureUnion
   String.s
EndStructure

Structure EvaluatorEnvironment
   Map Variable.EvaluatorVariable()
EndStructure

Structure Evaluator
   Database.i
   List Environment.EvaluatorEnvironment()
EndStructure


; Initialisierung

Procedure InitEvaluator()
   Global Evaluator.Evaluator
   UseSQLiteDatabase()
   Evaluator\Database = OpenDatabase(#PB_Any, ":memory:", "", "", #PB_Database_SQLite)
EndProcedure


; Interne Funktion

Procedure.i Evaluator_DatabaseQuery(String.s, *Environment.EvaluatorEnvironment=#Null)
   Protected Valiabels.s, Query.s = "SELECT "+String
   If *Environment And MapSize(*Environment\Variable())
      Query + " FROM ( SELECT "
      ForEach *Environment\Variable()
         If Valiabels : Valiabels + ", " : EndIf
         Select *Environment\Variable()\Type
            Case #Evaluator_VariableType_String
               Valiabels + "'"+ReplaceString(*Environment\Variable()\String, "'", "''")+"'"
            Case #Evaluator_VariableType_Integer
               Valiabels + Str(*Environment\Variable()\Integer)
            Case #Evaluator_VariableType_Float
               Valiabels + StrF(*Environment\Variable()\Float)
         EndSelect
         Valiabels + " AS "+MapKey(*Environment\Variable())
      Next
      Query + Valiabels + ")"
   EndIf
   ProcedureReturn DatabaseQuery(Evaluator\Database, Query)
EndProcedure


; EvaluatorEnvironment 

Procedure.i NewEvaluatorEnvironment()
   ProcedureReturn AddElement(Evaluator\Environment())
EndProcedure

Procedure FreeEvaluatorEnvironment(*Environment.EvaluatorEnvironment)
   ChangeCurrentElement(Evaluator\Environment(), *Environment)
   DeleteElement(Evaluator\Environment())
EndProcedure

Procedure.i SetEvaluatorEnvironmentString(*Environment.EvaluatorEnvironment, Name.s, Value.s="")
   AddMapElement(*Environment\Variable(), Name)
   *Environment\Variable()\Type = #Evaluator_VariableType_String
   *Environment\Variable()\String = Value
EndProcedure

Procedure.i SetEvaluatorEnvironmentInteger(*Environment.EvaluatorEnvironment, Name.s, Value.i=0)
   AddMapElement(*Environment\Variable(), Name) 
   *Environment\Variable()\Type = #Evaluator_VariableType_Integer
   *Environment\Variable()\Integer = Value
EndProcedure

Procedure.i SetEvaluatorEnvironmentFloat(*Environment.EvaluatorEnvironment, Name.s, Value.f=0)
   AddMapElement(*Environment\Variable(), Name) 
   *Environment\Variable()\Type = #Evaluator_VariableType_Float
   *Environment\Variable()\Float = Value
EndProcedure


; Evaluator

Procedure.i Evaluate(String.s, *Environment.EvaluatorEnvironment=#Null)
   If Trim(String) = "" : String = "0" : EndIf
   If Evaluator_DatabaseQuery(String, *Environment)
      If NextDatabaseRow(Evaluator\Database)
         CompilerIf SizeOf(Integer) = SizeOf(Quad)
            ProcedureReturn GetDatabaseQuad(Evaluator\Database, 0)
         CompilerElse
            ProcedureReturn GetDatabaseLong(Evaluator\Database, 0)
         CompilerEndIf
      EndIf
      FinishDatabaseQuery(Evaluator\Database)
   EndIf
EndProcedure

Procedure.s EvaluateS(String.s, *Environment.EvaluatorEnvironment=#Null)
   If Trim(String) = "" : String = "''" : EndIf
   If Evaluator_DatabaseQuery(String, *Environment)
      If NextDatabaseRow(Evaluator\Database)
         ProcedureReturn GetDatabaseString(Evaluator\Database, 0)
      EndIf
      FinishDatabaseQuery(Evaluator\Database)
   EndIf   
EndProcedure


Procedure.f EvaluateF(String.s, *Environment.EvaluatorEnvironment=#Null)
   If Trim(String) = "" : String = "0.0" : EndIf
   If Evaluator_DatabaseQuery(String, *Environment)
      If NextDatabaseRow(Evaluator\Database)
         ProcedureReturn GetDatabaseFloat(Evaluator\Database, 0)
      EndIf
      FinishDatabaseQuery(Evaluator\Database)
   EndIf
EndProcedure

Procedure.s EvaluateError()
   ProcedureReturn DatabaseError()
EndProcedure


; Beispiel

InitEvaluator()

Debug "-----------------"
Debug Evaluate("1 + 2 + 3")
Debug EvaluateF("0.25 * 2")
Debug EvaluateS("'Hallo' || ' Welt'")
Debug "-----------------"

*Environment = NewEvaluatorEnvironment()
SetEvaluatorEnvironmentInteger(*Environment, "n", 64)
SetEvaluatorEnvironmentString(*Environment, "Text", "Hallo Welt")
SetEvaluatorEnvironmentFloat(*Environment, "f", 0.25)

Debug Evaluate("n < 100 AND n > 50", *Environment)
Debug EvaluateF("n * f", *Environment)
Debug EvaluateS("(100 * f) || ' %'", *Environment)

Re: Strings mit SQLite berechnen

Verfasst: 07.05.2011 13:21
von iostream
Vaska Hulja hat geschrieben:Wo bist du denn Praktikant? Theorie ist für Sesselfurzer. Zeig deinen Code oder lass es, aber bitte keine nervigen Sprüche. :lol:
Kein Praktikant, ich studiere Physik. Ich beschäftige mich im Prinzip täglich mit Theorie ^^

Wegen des Codes: http://forums.purebasic.com/german/view ... e6cff75f4d

Re: Strings mit SQLite berechnen

Verfasst: 07.05.2011 14:27
von Danilo
Minimal. Ungetestet. Voll mit Fehlern. Ohne jegliche Fehlerbehandlung hingeschmiert.
...aber vielleicht was zum rumspielen (angelehnt an STARGÅTEs Code):

Code: Alles auswählen

EnableExplicit

Enumeration
   #tkError
   #tkIdentifier
   #tkInteger
   #tkFloat
   
   #tkOpenParen
   #tkCloseParen
   
   #__firstOperator
       #tkAdd
       #tkSub
       #tkMul
       #tkDiv
       #tkMod
       #tkPow
   #__lastOperator
EndEnumeration

Structure Token
   spelling.s
   type.l
EndStructure

Global NewMap EvaluateVariables.s()

Procedure.l __germanUmlaut(char.c)
    If char='ä' Or char='ö' Or char='ü' Or char='Ä' Or char='Ö' Or char='Ü' Or char='ß'
        ProcedureReturn #True
    EndIf
    ProcedureReturn #False
EndProcedure

Procedure __getToken(*start.Character, *tk.Token, lookUpOnly.l=0)
    Define *oldStart.Character = *start

    If *start And *tk
        *tk\spelling = ""
        *tk\type     = 0
        While *start\c = ' ' Or *start\c = #TAB
            *start + SizeOf(Character)
        Wend
        Select *start\c 
            Case '0' To '9'
                While *start\c >= '0' And *start\c <= '9'
                    *tk\spelling + Chr(*start\c)
                    *start + SizeOf(Character)
                Wend
                If *start\c = '.'
                    *tk\spelling + "."
                    *start + SizeOf(Character)
                    While *start\c >= '0' And *start\c <= '9'
                        *tk\spelling + Chr(*start\c)
                        *start + SizeOf(Character)
                    Wend
                    *tk\type     = #tkFloat
                Else
                    *tk\type     = #tkInteger
                EndIf
            Case 'a' To 'z' , 'A' To 'Z' , '_','ä','ö','ü','Ä','Ö','Ü','ß'
                While (*start\c >= 'a' And *start\c <= 'z') Or (*start\c >= 'A' And *start\c <= 'Z') Or *start\c = '_' Or __germanUmlaut(*start\c)
                    *tk\spelling + Chr(*start\c)
                    *start + SizeOf(Character)
                Wend
                If FindMapElement(EvaluateVariables(),*tk\spelling)
                    *tk\spelling = EvaluateVariables()
                Else
                    *tk\spelling = "0"
                EndIf
                *tk\type     = #tkFloat
            Case '+'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkAdd
                *start + SizeOf(Character)
            Case '-'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkSub
                *start + SizeOf(Character)
            Case '*'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkMul
                *start + SizeOf(Character)
            Case '/'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkDiv
                *start + SizeOf(Character)
            Case '%'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkMod
                *start + SizeOf(Character)
            Case '^'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkPow
                *start + SizeOf(Character)
            Case '('
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkOpenParen
                *start + SizeOf(Character)
            Case ')'
                *tk\spelling + Chr(*start\c)
                *tk\type     = #tkCloseParen
                *start + SizeOf(Character)
            Default
                *tk\spelling = Chr(*start\c)
                *tk\type     = #tkError
                *start + SizeOf(Character)
        EndSelect
        If lookUpOnly
            ProcedureReturn *oldStart
        Else
            ProcedureReturn *start
        EndIf
    EndIf
    ProcedureReturn 0
EndProcedure

Declare __parseExpression(*start.Character, *tk.Token)

Procedure __parseFactor(*start.Character, *tk.Token)
    Define tk.Token
    *start = __getToken(*start,*tk)
    If *start
        If *tk\type = #tkInteger Or *tk\type = #tkFloat ;Or *tk\type = #tkIdentifier
            ProcedureReturn *start
        ElseIf *tk\type = #tkSub
            *start = __getToken(*start,*tk)
            If *tk\type = #tkInteger Or *tk\type = #tkFloat
                *tk\spelling = "-"+*tk\spelling
                ProcedureReturn *start
            EndIf
        ElseIf *tk\type = #tkOpenParen
            *start = __parseExpression(*start,*tk)
            *start = __getToken(*start,@tk,#True)
            If *start
                If tk\type = #tkCloseParen
                    *start = __getToken(*start,@tk)
                EndIf
                ProcedureReturn *start
            EndIf
        EndIf
    EndIf
    ProcedureReturn 0
EndProcedure

Procedure __parseTerm(*start.Character, *tk.Token)
    Define tk.Token
    *start = __parseFactor(*start,*tk)
    If *start
        Repeat
            *start = __getToken(*start,@tk,#True)
            If *start
                Select tk\type
                    Case #tkMul
                        *start = __getToken(*start,@tk)
                        *start = __parseFactor(*start,@tk)
                        *tk\spelling = StrD( ValD(*tk\spelling) * ValD(tk\spelling) )
                        *tk\type     = #tkFloat
                        Continue
                    Case #tkDiv
                        *start = __getToken(*start,@tk)
                        *start = __parseFactor(*start,@tk)
                        Define f2.f = ValD(tk\spelling)
                        If f2
                            *tk\spelling = StrD( ValD(*tk\spelling) / f2 )
                            *tk\type     = #tkFloat
                        Else
                            *tk\spelling = "0"       ; ERROR, Div with 0... we just ignore it
                            *tk\type     = #tkFloat
                        EndIf
                        Continue
                    Case #tkMod
                        *start = __getToken(*start,@tk)
                        *start = __parseFactor(*start,@tk)
                        Define q2.q = IntQ(ValD(tk\spelling))
                        If q2=0
                            *tk\spelling = "0"       ; ERROR, Modulo with 0... we just ignore it
                            *tk\type     = #tkFloat
                        Else
                            *tk\spelling = Str( (IntQ(ValD(*tk\spelling)) % q2))
                            *tk\type     = #tkFloat
                        EndIf
                        Continue
                    Case #tkPow
                        *start = __getToken(*start,@tk)
                        *start = __parseFactor(*start,@tk)
                        *tk\spelling = StrD( Pow( ValD(*tk\spelling) , ValD(tk\spelling) ) )
                        *tk\type     = #tkFloat
                        Continue
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    EndIf
    ProcedureReturn *start
EndProcedure

Procedure __parseExpression(*start.Character, *tk.Token)
    Define tk.Token
    *start = __parseTerm(*start,*tk)
    If *start
        Repeat
            *start = __getToken(*start,@tk,#True)
            If *start
                Select tk\type
                    Case #tkAdd
                        *start = __getToken(*start,@tk)
                        *start = __parseTerm(*start,@tk)
                        *tk\spelling = StrD( ValD(*tk\spelling) + ValD(tk\spelling) )
                        *tk\type     = #tkFloat
                        Continue
                    Case #tkSub
                        *start = __getToken(*start,@tk)
                        *start = __parseTerm(*start,@tk)
                        *tk\spelling = StrD( ValD(*tk\spelling) - ValD(tk\spelling) )
                        *tk\type     = #tkFloat
                        Continue
                    Default
                        Break
                EndSelect
            Else
                Break
            EndIf
        ForEver
    EndIf
    ProcedureReturn *start
EndProcedure

Procedure.s  Evaluate(expression.s)
    Define *start.Character = @expression
    Define tk1.Token, tk2.Token
    Define temp.s

    Repeat
        *start = __parseExpression(*start,@tk1)
        If *start
            *start = __getToken(*start,@tk2)
            If *start
                If tk2\type > #__firstOperator And tk2\type < #__lastOperator
                    temp = tk1\spelling + PeekS(*start)
                    *start = @temp
                    Continue
                EndIf
            EndIf
        EndIf
        Break
    ForEver
    temp = tk1\spelling
    If FindString(temp,".",1)
        temp = RTrim(temp,"0")
    EndIf
    temp = RTrim(temp,".")
    If temp = ""
        temp = "0"
    EndIf
    ProcedureReturn temp
EndProcedure


Debug Evaluate("1/3")
Debug Evaluate("1 + 2 + 3")
Debug Evaluate("-1 + -2")
Debug Evaluate("0.25 * 2")
Debug Evaluate("12 + 54 * 7 / 3 * 0.5 - 0.5")
Debug Evaluate("124 % 10")
Debug Evaluate("2^3")
Debug Evaluate("0.0000000001 + 0.0000000001")
Debug Evaluate("12*(1+3*(1+1))")

EvaluateVariables("n") = "15"

Debug Evaluate("n * 2")

EvaluateVariables("x") = "4.55"

Debug Evaluate("x * 4")

EvaluateVariables("n") = "64"
EvaluateVariables("f") = "0.25"

Debug Evaluate("n * f")

EvaluateVariables("_äöüÄÖÜß") = "1234567890"

Debug Evaluate("_äöüÄÖÜß")

Debug Evaluate("variable * 18") ; variable = undefined = 0
Debug Evaluate("1 % 0")         ; modulo   with 0
Debug Evaluate("1 / 0")         ; division with 0

Re: Strings mit SQLite berechnen

Verfasst: 07.05.2011 14:29
von Vaska Hulja
@iostream: Wegen des Codes...
Das sieht nach solider, sauberer Arbeit aus, und funktioniert anständig. :allright:

Für kleinere Sachen, bei denen es nicht auf Performance und Platz ankommt, ist mir die Datenbanklösung aber genauso recht. Für einen Compiler reicht sie natürlich nicht aus. >:)

Re: Strings mit SQLite berechnen

Verfasst: 07.05.2011 14:40
von mk-soft
Ist ja witzig...

Code: Alles auswählen



EnableExplicit

UseSQLiteDatabase()

Procedure CreateTable(db)
  
  If DatabaseUpdate(db, "CREATE TABLE termen (id integer primary key autoincrement , a real, b real, c real);")
    ProcedureReturn #True
  Else
    MessageRequester("Fehler CreateTable", DatabaseError())
    ProcedureReturn #False
  EndIf
  
EndProcedure

Procedure InsertValues(db, a.f, b.f, c.f)
  
  Protected sql.s
  
  sql = "Insert Into termen (a,b,c) Values (" + StrF(a) + "," + StrF(b) + "," + StrF(c) + ");"
  If DatabaseUpdate(db, sql)
    ProcedureReturn #True
  Else
    MessageRequester("Fehler InsertValues", DatabaseError())
    ProcedureReturn #False
  EndIf
  
EndProcedure

; test

Define db.i = OpenDatabase(#PB_Any, ":memory:", "", "", #PB_Database_SQLite)

CreateTable(db)

Define.f a,b,c
Define i
For i = 1 To 20
  a = Random(10000) / 100.0
  b = Random(10000) / 100.0
  c = Random(10000) / 100.0
  If InsertValues(db, a, b, c) = #False
    Break
  EndIf
Next  

Define.s formel
formel = "a + b + c"
If DatabaseQuery(db, "SELECT (" + formel + ") as result from termen")
  While NextDatabaseRow(db)
    Debug StrF(GetDatabaseFloat(db, 0), 2)
  Wend
  FinishDatabaseQuery(db)
EndIf  

CloseDatabase(db)
FF :wink:

P.S.
Habe mal eine kleinen Fehler beseitig.
Ist es wirklich viel langsamer die Tabellenwerte in die Datenbank zu schreiben und dann berechnen zu lassen?

Re: Strings mit SQLite berechnen

Verfasst: 20.11.2011 16:03
von shim
Hi!

Ich wärme das Thema nochmal auf.

Eine globale Variable macht die Datenbanklösung auch schleifentauglich. Nur bei sporadischen Aufrufen wird die PB-Variante schneller sein, wo der Break-Even Punkt liegt, hängt bestimmt von der Komplexität des Terms ab. Mit evaluate_end() kann man die Memory-Datenbank wieder schließen, wenn sie nicht mehr benötigt wird.
Ein weiterer Vorteil der Datenbanklösung ist aus meiner Sicht die Möglichkeit sämtliche SQLite-Funktionen nutzen zu können.

Code: Alles auswählen

Global __evaluate_temp_id ; Beschleunigt die Routine etwas
Procedure.s evaluate(string2parse$)
  Protected dummy$,res
  If __evaluate_temp_id=#False
    If UseSQLiteDatabase()
      __evaluate_temp_id=OpenDatabase(#PB_Any, ":memory:", "", "", #PB_Database_SQLite)
    Else
      Debug "Fehler!"
    EndIf
  EndIf
  res=DatabaseQuery(__evaluate_temp_id,"SELECT "+string2parse$)
  If res = 0
    Debug DatabaseError()
    dummy$=""
  Else
    NextDatabaseRow(__evaluate_temp_id)
    dummy$=GetDatabaseString(__evaluate_temp_id,0)
  EndIf
  ProcedureReturn dummy$
EndProcedure
 
Procedure evaluate_end()
  CloseDatabase(__evaluate_temp_id)
  __evaluate_temp_id=#False
EndProcedure
 
 
CompilerIf 1
StartTime = ElapsedMilliseconds()
For r= 1 To 1000
   a$=evaluate(Str(r)+"*"+Str(r)+"*"+Str(r))
 Next r
ElapsedTime = ElapsedMilliseconds()-StartTime
Debug (ElapsedTime)
 
Debug evaluate("'Hallo'" + "||" + "'Welt'")
evaluate_end()
CompilerEndIf

Re: Strings mit SQLite berechnen

Verfasst: 20.11.2011 19:16
von Waldixxl
Hallo shim

Es geht auch ohne einer globale Variable

Code: Alles auswählen

Procedure.s evaluate(string2parse$="")
   Protected dummy$,res
   Static DB_temp_id
   
   If string2parse$=""
      CloseDatabase(DB_temp_id)
      DB_temp_id=#False
      ProcedureReturn "Close DB"
   EndIf
   
   If DB_temp_id=#False
      If UseSQLiteDatabase()
         DB_temp_id=OpenDatabase(#PB_Any, ":memory:", "", "", #PB_Database_SQLite)
      Else
         Debug "Fehler!"
      EndIf
   EndIf
   
   res=DatabaseQuery(DB_temp_id,"SELECT "+string2parse$)
   If res = 0
      Debug DatabaseError()
      dummy$=""
   Else
      NextDatabaseRow(DB_temp_id)
      dummy$=GetDatabaseString(DB_temp_id,0)
   EndIf
   ProcedureReturn dummy$
EndProcedure

CompilerIf 1
   StartTime = ElapsedMilliseconds()
   For r= 1 To 10000
      a$=evaluate(Str(r)+"*"+Str(r)+"*"+Str(r))
   Next r
   ElapsedTime = ElapsedMilliseconds()-StartTime
   Debug (ElapsedTime)
   
   Debug evaluate("'Hallo'" + "||" + "'Welt'")
   Debug evaluate() ;Datenank schliessen
CompilerEndIf
Walter

Re: Strings mit SQLite berechnen

Verfasst: 20.11.2011 19:46
von NicTheQuick
STARGÅTE hat geschrieben:Das ganze heißt bei mir Evaluater.
Nichts für Ungut, aber es heißt Evaluator. Außer du willst es wirklich als Eigennamen haben.

Re: Strings mit SQLite berechnen

Verfasst: 21.11.2011 02:07
von STARGÅTE
:oops:

Ups, jo da hilft dann auch kein EnableExplicit, wenn man durchgängig alle Konstanten bzw. Variablen mit e statt o schreibt^^

Habe mein Beitrag geändert.
Alle Zeiten sind UTC+02:00
Seite 2 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de