XProfan

English

Michael
W.

Suchalgorithmen Knuth-Morris-Pratt, Boyer-Moore, Horspool, Sunday

here time a couple Suchroutinen
Compile Mark Separation

' 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]);pattern

                                EndWhile

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

P.s.:
The Headline becomes but durchgekaut - auweia

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

12/28/14 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Balphaetisch sortiert, Schlagworte should indicated go, no cover - thatswhy too Fürwortelöschung etc.

XProfan X2
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

12/28/14 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
W.

Oh, stood there "Schlagworte"? Have I then well overlooking...

XProfan X3
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

12/28/14 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

No, stood and standing there not.

having it of course time here and there declared as functions but the wars then already.

If you one Snip have with the Worten: olpha, pheta and comma,
then Better get going einsortiert the Topic with:

olpha pheta comma
pheta olpha comma
comma olpha pheta

Virtually any Wortekombinationen durchgenudelt sodasses findbar is with alike welchem word.

meaningfully with so Dingensen How:

Festplatte straighten up and temporary Files delete

Can then find with

straighten up, Festplatte temporary Files delete
Files, Festplatte straighten up temporary delete
Festplatte, straighten up temporary Files delete
delete, Festplatte straighten up temporary Files
temporary, Festplatte straighten up Files delete

XProfan X2
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

12/28/14 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

Knut has nothing with the loves Eisbärbaby To do, the then verendete, separate with Prof.em.Dr.Dr.Drhc. Donald Knuth - with h hinten, DEM Algorithmenpapst!!!!!!

Boyer-Moore, Morris-Pratt are Algorithmentitel. Boyer alone has what integrally other made. hyphen would but one Doppelnamen, question: Gibt´s not one not-trennendes space for such Cases? how'bout ersatzweise with the Unterstrich _ ?

Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

06/12/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

Proc-part for XProfan-11.2a or. free verdaubar made:

Compile Mark Separation

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