Hätte ich doch beinahe die einfachsten vergessen...
Binärsuche in sortierten Daten...
Mal nicht getestet, aber dafür für ältere Versionen angepasst.
Code
' binäre Suche
' - bin_search_intArr
' - bin_search_strArr
' - bin_search_List
' aus den beiden folgenden ist's entstanden
' - Bin_Search_Rek
' - Bin_Search
Proc bin_search_intArr
' Durchsucht ein übergebenes INT-Array nach einem Suchwert.
' Ist bis = 0, dann wird das ganze Array durchsucht.
' Ist der gleiche Suchwert mehrfach enthalten,
' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
Parameters Arr&[], Suchwert&, von&, bis&
Declare maxi&, mitte&, vonOri&
maxi& = SizeOf(Arr&[])
' Ist bis = 0, dann wird das ganze Array durchsucht.
Case bis& = 0 : bis& = maxi& - 1
If (von& < maxi&) and (bis& < maxi&)
vonOri& = von&
While von& <= bis&
mitte& = von& + ((bis& - von&) / 2)
If Arr&[mitte&] = Suchwert& ' hier ist ein Wert gefunden
' jetzt gehen wir bis zum ersten Duplikat zurück (falls vorhanden)
While (mitte& > 0) and (mitte& > vonOri&)
If Arr&[mitte& - 1] = Suchwert&
' Duplikat gefunden
Dec mitte&
Else
BREAK
EndIf
EndWhile
Return mitte&
ElseIf Arr&[mitte&] > Suchwert&
bis& = mitte& - 1 ' suche im vorderen Teil weiter
Else 'Arr&[mitte&] < Suchwert&
von& = mitte& + 1 ' suche im hinteren Teil weiter
EndIf
EndWhile
EndIf
Return -1 ' Suchwert nicht gefunden
EndProc
Proc bin_search_strArr
' Durchsucht ein übergebenes String-Array nach einem Suchwert.
' Ist bis = 0, dann wird das ganze Array durchsucht.
' Ist der gleiche Suchwert mehrfach enthalten,
' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
' Groß-/Kleinschreibung egal, wenn ignoreCase% <> 0
' Beginnt mit Suchwert, wenn startedWith% <> 0
Parameters Arr$[], Suchwert$, von&, bis&, ignoreCase%, startedWith%
Declare maxi&, mitte&, vonOri&, suchLen&, vgl$
maxi& = SizeOf(Arr$[])
Case ignoreCase% : Suchwert$ = Lower$(Suchwert$)
suchLen& = Len(Suchwert$)
' Ist bis = 0, dann wird das ganze Array durchsucht.
Case bis& = 0 : bis& = maxi& - 1
If (von& < maxi&) and (bis& < maxi&)
vonOri& = von&
While von& <= bis&
mitte& = von& + ((bis& - von&) / 2)
vgl$ = Arr$[mitte&]
Case ignoreCase% : vgl$ = Lower$(vgl$)
Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
If vgl$ = Suchwert$ ' hier ist ein Wert gefunden
' jetzt gehen wir bis zum ersten Vorkommen zurück (falls vorhanden)
While (mitte& > 0) and (mitte& > vonOri&)
vgl$ = Arr$[mitte& - 1]
Case ignoreCase% : vgl$ = Lower$(vgl$)
Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
If vgl$ = Suchwert$
' Vorgänger gefunden
Dec mitte&
Else
BREAK
EndIf
EndWhile
Return mitte&
ElseIf vgl$ > Suchwert$
bis& = mitte& - 1 ' suche im vorderen Teil weiter
Else 'Arr$[mitte&] < Suchwert$
von& = mitte& + 1 ' suche im hinteren Teil weiter
EndIf
EndWhile
EndIf
Return -1 ' Suchwert nicht gefunden
EndProc
Proc bin_search_List
' Durchsucht eine Liste nach einem Suchwert.
' Ist bis = 0, dann wird die ganze Liste durchsucht.
' Ist der gleiche Suchwert mehrfach enthalten,
' dann wird das erste Vorkommen zurückgegeben. (Kann entarten.)
' Groß-/Kleinschreibung egal, wenn ignoreCase% <> 0
' Beginnt mit Suchwert, wenn startedWith% <> 0
Parameters hListe&, Suchwert$, von&, bis&, ignoreCase%, startedWith%
Declare maxi&, mitte&, vonOri&, suchLen&, vgl$
maxi& = GetCount(hListe&)
Case ignoreCase% : Suchwert$ = Lower$(Suchwert$)
suchLen& = Len(Suchwert$)
' Ist bis = 0, dann wird das ganze Array durchsucht.
Case bis& = 0 : bis& = maxi& - 1
If (von& < maxi&) and (bis& < maxi&)
vonOri& = von&
While von& <= bis&
mitte& = von& + ((bis& - von&) / 2)
vgl$ = GetString$(hListe&,mitte&)
Case ignoreCase% : vgl$ = Lower$(vgl$)
Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
If vgl$ = Suchwert$ ' hier ist ein Wert gefunden
' jetzt gehen wir bis zum ersten Vorkommen zurück (falls vorhanden)
While (mitte& > 0) and (mitte& > vonOri&)
vgl$ = GetString$(hListe&,mitte& - 1)
Case ignoreCase% : vgl$ = Lower$(vgl$)
Case startedWith% : vgl$ = Left$(vgl$,suchLen&)
If vgl$ = Suchwert$
' Vorgänger gefunden
Dec mitte&
Else
BREAK
EndIf
EndWhile
Return mitte&
ElseIf vgl$ > Suchwert$
bis& = mitte& - 1 ' suche im vorderen Teil weiter
Else 'Arr$[mitte&] < Suchwert$
von& = mitte& + 1 ' suche im hinteren Teil weiter
EndIf
EndWhile
EndIf
Return -1 ' Suchwert nicht gefunden
EndProc
Proc Bin_Search_Rek
Parameters WerteArr&[], Suchwert&, Start&, Ende&
Declare Mitte&
If Ende& >= Start&
Mitte& = Start& + ((Ende& - Start&) / 2)
If WerteArr&[Mitte&] = Suchwert&
Return Mitte&
ElseIf WerteArr&[Mitte&] > Suchwert&
Return Bin_Search_Rek(WerteArr&[], Suchwert&, Start&, Mitte& - 1)
Else
Return Bin_Search_Rek(WerteArr&[], Suchwert&, Mitte& + 1, Ende&)
EndIf
EndIf
Return -1
EndProc
Proc Bin_Search
Parameters WerteArr&[], Suchwert&, Start&, Ende&
Declare Mitte&, schluss&
schluss& = SizeOf(WerteArr&[]) - 1 : Case schluss& < Ende& : Ende& = schluss&
While Start& <= Ende&
Mitte& = Start& + ((Ende& - Start&) / 2)
If WerteArr&[Mitte&] = Suchwert&
Return Mitte&
ElseIf WerteArr&[Mitte&] > Suchwert&
Ende& = Mitte& - 1
Else
Start& = Mitte& + 1
EndIf
EndWhile
Return -1
EndProc
Alles anzeigen