XProfan

' XProfan X2
' Suchalgorithmen
' - Knuth-Morris-Pratt (KMP)
' - Boyer-Moore
' - Horspool
' - Sunday
' Diese Algorithmen untersuchen erst den Suchbegriff und bilden eine
' oder mehrere Sprungtabellen, um den Suchbegriff schneller über den
' zu untersuchenden Text zu schieben.
' Wenn diese Prozedur vom eigentlichen Suchen getrennt wird, dann
' können mit EINER Sprungtabelle mehrere große Textteile nacheinander
' untersucht werden.
' Außerdem wird hier mit Adressen gearbeitet, um sowohl in einfachen
' Strings als auch in Bereichen suchen zu können.
' Die Routinen sind also geteilt in XXX_Tab und XXX_Search

Proc MinF

    Parameters Float a,b
    Return if(a<b,a,b)

EndProc

Proc MaxF

    Parameters Float a,b
    Return if(a>b,a,b)

EndProc

Proc MinQ

    Parameters Quad a,b
    Return if(a<b,a,b)

EndProc

Proc MaxQ

    Parameters Quad a,b
    Return if(a>b,a,b)

EndProc

Proc MatchesAt

    Parameters Long SourceStart, SourceLen, PatternStart, PatternLen, Posi
    Var Long j = 0

    While (j < PatternLen) and (Char$(PatternStart,j,1) = Char$(SourceStart,Posi+j,1))

        Inc j

    EndWhile

    Return (j = PatternLen)'volle Übereinstimmung

EndProc

' ==================================
' - Knuth-Morris-Pratt (KMP)
' untersucht den Suchbegriff und liefert ein dynamisches Array zurück

Proc KMP_Tab

    Parameters Long PatternStart, PatternLen
    Declare Long PreTab[]
    Var Long i = 0
    Var Long j = -1
    PreTab[i] = j

    While i < PatternLen

        While (j >= 0) and (Char$(PatternStart,j,1) <> Char$(PatternStart,i,1))

            j = PreTab[j]

        EndWhile

        Inc i
        Inc j
        PreTab[i] = j

    EndWhile

    Return PreTab[]

EndProc

' ----------------------------------
' - Knuth-Morris-Pratt (KMP)
' liefert ein dyn. Array mit den Fundstellen zurück

Proc KMP_Search

    Parameters Long SourceStart, SourceLen,  PatternStart, PatternLen,  MaxTreffer, PrefixTab[]
    Declare Long TrefferTab[]
    Var Long Treffer = 0
    Var Long i = 0
    Var Long j = 0

    While i < SourceLen

        While (j >= 0) and (Char$(SourceStart,i,1) <> Char$(PatternStart,j,1))

            j = PrefixTab[j]'Muster verschieben

        EndWhile

        Inc i : Inc j

        If j = PatternLen

            TrefferTab[Treffer] = i - PatternLen
            Inc Treffer
            j = PrefixTab[j]'Muster verschieben

        EndIf

        Case (MaxTreffer <> 0) and (Treffer >= MaxTreffer) : BREAK

    EndWhile

    Return TrefferTab[]

EndProc

' ==================================
' ==================================
' - Boyer-Moore
' untersucht den Suchbegriff und liefert ein dynamisches Array zurück

Proc BoyerMoore_Tab_Bad

    Parameters Long PatternStart, PatternLen
    Declare Long Bad_Tab[]
    ' die 'bad rule' des Boyer-Moore
    Bad_Tab[PatternLen] = 0

    WhileLoop 0,255

        Bad_Tab[&loop] = -1

    EndWhile

    WhileLoop 0,PatternLen - 1

        'Bad_Tab[&loop] = 0
        Bad_Tab[Ord(Char$(PatternStart,&loop,1))] = &loop

    EndWhile

    Return Bad_Tab[]

EndProc

' - Boyer-Moore
' untersucht den Suchbegriff und liefert ein dynamisches Array zurück

Proc BoyerMoore_Tab_Good

    Parameters Long PatternStart, PatternLen
    Declare Long Good_Tab[], tmp[], i,j
    ' die 'good rule' des Boyer-Moore
    ' stufe 1
    i = PatternLen - 1
    j = PatternLen
    tmp[i] = j

    WhileLoop 0,PatternLen

        Good_Tab[&loop] = 0

    EndWhile

    While i > 0

        While (j < PatternLen) and (Char$(PatternStart,i-1,1) <> Char$(PatternStart,j-1,1))

            Case Good_Tab[j] = 0 : Good_Tab[j] = j - i
            j = tmp[j]

        EndWhile

        Dec i
        Dec j
        tmp[i] = j

    EndWhile

    ' stufe 2
    j = tmp[0]

    WhileLoop 0,PatternLen-1

        Case Good_Tab[&loop] = 0 : Good_Tab[&loop] = j
        Case &loop = j : j = tmp[j]

    EndWhile

    Return Good_Tab[]

EndProc

' ----------------------------------
' - Boyer-Moore-Algorithmus

Proc BoyerMoore_Search

    Parameters Long SourceStart, SourceLen,  PatternStart, PatternLen,  MaxTreffer, BadTab[], GoodTab[]
    Declare Long TrefferTab[], i,j
    Var Long Treffer = 0
    Case PatternLen > SourceLen : Return TrefferTab[]
    i = 0

    While i <= (SourceLen - PatternLen)

        j = PatternLen - 1

        While (j >= 0) and (Char$(PatternStart,j,1) = Char$(SourceStart,i+j,1))

            Dec j

        EndWhile

        If j < 0

            TrefferTab[Treffer] = i
            Inc Treffer
            Inc i, GoodTab[0]

        Else

            Inc i, MaxQ( GoodTab[j + 1], j - BadTab[Ord(Char$(SourceStart,i + j,1))] )

        EndIf

        Case (MaxTreffer <> 0) and (Treffer >= MaxTreffer) : BREAK

    EndWhile

    Return TrefferTab[]

EndProc

' ==================================
' ==================================
' - Horspool
' untersucht den Suchbegriff und liefert ein dynamisches Array zurück

Proc Horspool_Tab

    Parameters Long PatternStart, PatternLen
    Declare Long PreTab[]

    WhileLoop 0,255

        PreTab[&loop] = -1

    EndWhile

    WhileLoop 0,PatternLen-2

        PreTab[Ord(Char$(PatternStart,&loop,1))] = &loop

    EndWhile

    Return PreTab[]

EndProc

' ----------------------------------
' - Horspool
' liefert ein dyn. Array mit den Fundstellen zurück

Proc Horspool_Search

    Parameters Long SourceStart, SourceLen,  PatternStart, PatternLen,  MaxTreffer, PrefixTab[]
    Declare Long TrefferTab[], i,j
    Var Long Treffer = 0
    Case PatternLen > SourceLen : Return TrefferTab[]
    i = 0

    While i <= (SourceLen - PatternLen)

        j = PatternLen - 1

        While (j >= 0) and (Char$(PatternStart,j,1) = Char$(SourceStart,i+j,1))

            Dec j

        EndWhile

        if (j < 0)

            TrefferTab[Treffer] = i : Inc Treffer

        EndIf

        Inc i, (PatternLen - 1)
        Dec i, PrefixTab[Ord(Char$(SourceStart,i,1))]

    EndWhile

    Return TrefferTab[]

EndProc

' ==================================
' ==================================
' - Sunday-Algorithmus
' untersucht den Suchbegriff und liefert ein dynamisches Array zurück

Proc Sunday_Tab

    Parameters Long PatternStart, PatternLen
    Declare Long PreTab[]

    WhileLoop 0,255

        PreTab[&loop] = -1

    EndWhile

    WhileLoop 0,PatternLen-1

        PreTab[Ord(Char$(PatternStart,&loop,1))] = &loop

    EndWhile

    Return PreTab[]

EndProc

' ----------------------------------
' - Sunday-Algorithmus
' liefert ein dyn. Array mit den Fundstellen zurück

Proc Sunday_Search

    Parameters Long SourceStart, SourceLen,  PatternStart, PatternLen,  MaxTreffer, PrefixTab[]
    Declare Long TrefferTab[], i,j
    Var Long Treffer = 0
    Case PatternLen > SourceLen : Return TrefferTab[]
    i = 0

    While i <= (SourceLen - PatternLen)

        If MatchesAt(SourceStart, SourceLen, PatternStart, PatternLen, i)

            TrefferTab[Treffer] = i
            Inc Treffer

        EndIf

        Inc i, PatternLen
        Case i < SourceLen : Dec i,PrefixTab[Ord(Char$(SourceStart,i,1))]

    EndWhile

    Return TrefferTab[]

EndProc

' ==================================
' ----------------------------------
' Testbereich
' ----------------------------------
Declare Long Ergebnisse[],Tab1[],Tab2[], lauf, String Quelle, Muster
' - Knuth-Morris-Pratt (KMP)
Clear Ergebnisse[],Tab1[]
Quelle = "abababcbababcababcabababcabab"
Muster = "ababcabab"
Tab1[] = KMP_Tab(addr(Muster),len(Muster))
Ergebnisse[] = KMP_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
Print "\nKnuth-Morris-Pratt: ";

WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

    WhileLoop 0,SizeOf(Ergebnisse[])-1

        Print Tab(3);Quelle
        Print Tab(3+Ergebnisse[&loop]);Muster

    EndWhile

    Clear Ergebnisse[],Tab1[]
    Quelle = "reinesupersauersupesupersupe"
    Muster = "supersupe"
    ' Wenn nur der zu durchsuchende Text sich ändert und
    ' das gleiche Suchmuster verwendet wird, dann braucht
    ' die Tabelle nicht erneuert zu werden.
    ' ---aber hier ändert sich auch der Suchwert---
    Tab1[] = KMP_Tab(addr(Muster),len(Muster))
    Ergebnisse[] = KMP_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
    Print "\nKnuth-Morris-Pratt: ";

    WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

        WhileLoop 0,SizeOf(Ergebnisse[])-1

            Print Tab(3);Quelle
            Print Tab(3+Ergebnisse[&loop]);Muster

        EndWhile

        Print "\nnächster Algorithmus"
        WaitInput
        ' -------------------------------
        ' - Boyer-Moore
        Clear Ergebnisse[],Tab1[],Tab2[]
        Quelle = "abababcbababcababcabababcabab"
        Muster = "ababcabab"
        Tab1[] = BoyerMoore_Tab_Bad(addr(Muster),len(Muster))
        Tab2[] = BoyerMoore_Tab_Good(addr(Muster),len(Muster))
        Ergebnisse[] = BoyerMoore_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[],Tab2[] )
        Print "\nBoyer-Moore: ";

        WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

            WhileLoop 0,SizeOf(Ergebnisse[&loop])-1

                Print Tab(3);Quelle
                Print Tab(3+Ergebnisse[&loop]);Muster

            EndWhile

            Clear Ergebnisse[],Tab1[],Tab2[]
            Quelle = "reinesupersauersupesupersupe"
            Muster = "supersupe"
            ' Wenn nur der zu durchsuchende Text sich ändert und
            ' das gleiche Suchmuster verwendet wird, dann braucht
            ' die Tabelle nicht erneuert zu werden.
            ' ---aber hier ändert sich auch der Suchwert---
            Tab1[] = BoyerMoore_Tab_Bad(addr(Muster),len(Muster))
            Tab2[] = BoyerMoore_Tab_Good(addr(Muster),len(Muster))
            Ergebnisse[] = BoyerMoore_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[],Tab2[] )
            Print "\nBoyer-Moore: ";

            WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

                WhileLoop 0,SizeOf(Ergebnisse[])-1

                    Print Tab(3);Quelle
                    Print Tab(3+Ergebnisse[&loop]);Muster

                EndWhile

                Print "\nnächster Algorithmus"
                WaitInput
                ' -------------------------------
                ' - Horspool
                Clear Ergebnisse[],Tab1[]
                Quelle = "abababcbababcababcabababcabab"
                Muster = "ababcabab"
                Tab1[] = Horspool_Tab(addr(Muster),len(Muster))
                Ergebnisse[] = Horspool_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
                Print "\nHorspool: ";

                WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

                    WhileLoop 0,SizeOf(Ergebnisse[])-1

                        Print Tab(3);Quelle
                        Print Tab(3+Ergebnisse[&loop]);Muster

                    EndWhile

                    Clear Ergebnisse[],Tab1[]
                    Quelle = "reinesupersauersupesupersupe"
                    Muster = "supersupe"
                    ' Wenn nur der zu durchsuchende Text sich ändert und
                    ' das gleiche Suchmuster verwendet wird, dann braucht
                    ' die Tabelle nicht erneuert zu werden.
                    ' ---aber hier ändert sich auch der Suchwert---
                    Tab1[] = Horspool_Tab(addr(Muster),len(Muster))
                    Ergebnisse[] = Horspool_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
                    Print "\nHorspool: ";

                    WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

                        WhileLoop 0,SizeOf(Ergebnisse[])-1

                            Print Tab(3);Quelle
                            Print Tab(3+Ergebnisse[&loop]);Muster

                        EndWhile

                        Print "\nnächster Algorithmus"
                        WaitInput
                        ' -------------------------------
                        ' - Sunday-Algorithmus
                        Clear Ergebnisse[],Tab1[]
                        Quelle = "abababcbababcababcabababcabab"
                        Muster = "ababcabab"
                        Tab1[] = Sunday_Tab(addr(Muster),len(Muster))
                        Ergebnisse[] = Sunday_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
                        Print "\nSunday: ";

                        WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

                            While SizeOf(Ergebnisse[])-1

                                Print Tab(3);Quelle
                                Print Tab(3+Ergebnisse[&loop]);Muster

                            EndWhile

                            Clear Ergebnisse[],Tab1[]
                            Quelle = "reinesupersauersupesupersupe"
                            Muster = "supersupe"
                            ' Wenn nur der zu durchsuchende Text sich ändert und
                            ' das gleiche Suchmuster verwendet wird, dann braucht
                            ' die Tabelle nicht erneuert zu werden.
                            ' ---aber hier ändert sich auch der Suchwert---
                            Tab1[] = Sunday_Tab(addr(Muster),len(Muster))
                            Ergebnisse[] = Sunday_Search(addr(Quelle),len(Quelle),addr(Muster),len(Muster), 5, Tab1[] )
                            Print "\nSunday: ";

                            WhileLoop 0,SizeOf(Ergebnisse[])-1 : Print Ergebnisse[&loop]; ";"; : EndWhile : Print " "

                                WhileLoop 0,SizeOf(Ergebnisse[])-1

                                    Print Tab(3);Quelle
                                    Print Tab(3+Ergebnisse[&loop]);Muster

                                EndWhile

                                Print "\nENDE - Taste drücken"
                                WaitKey
                                End

Proc BoyerMoore_Search

    Parameters SourceStart&,SourceLen&,PatternStart&,PatternLen&,MaxTreffer&,BadTab&[],GoodTab&[]
    Declare TrefferTab&[],i&,j&,Treffer&,v11&
    Treffer& = 0
    Case PatternLen& > SourceLen& : Return TrefferTab&[]
    i& = 0

    While i& <= (SourceLen& - PatternLen&)

        j& = PatternLen& - 1

        While (j&>=0) and (Char$(PatternStart&,j&,1) = Char$(SourceStart&,i&+j&,1))

            Dec j&

        EndWhile

        If j&<0

            TrefferTab&[Treffer&] = i&
            Inc Treffer&
            Inc i&,GoodTab&[0]

        Else

            v11&=MaxL( GoodTab&[j&+1], j&-BadTab&[Ord(Char$(SourceStart&,i&+j&,1))] )
            Inc i&,v11&

        EndIf

        if (MaxTreffer& <> 0) and (Treffer& >= MaxTreffer&)

            BREAK

        endif

    EndWhile

    Return TrefferTab&[]

EndProc