Binäre Suche

[Luckie]

Delphi-Quellcode:

(*
 * Author  : Michael Puff - [url]http://www.michael-puff.de[/url]
 * Date    : 2008-06-03
 * License : PUBLIC DOMAIN
 *)

unit BSearch;

interface

type
  TIntArray = array of Integer;
  TStrArray = array of string;
  TBSearch = class(TObject)
  private
    procedure QuickSort(var Strings: TStrArray; Start, Stop: Integer); overload;
    procedure QuickSort(var IntArray: TIntArray; Start, Stop: Integer); overload;
  public
    function Search(IntArray: TIntArray; x: Integer; Sorted: Boolean): Integer; overload;
    function Search(StrArray: TStrArray; s: string; Sorted: Boolean): Integer; overload;
  end;

implementation

{ TBSearch }

////////////////////////////////////////////////////////////////////////////////
// Procedure : TBSearch.QuickSort
// Author    : Derek van Daal
// Date      : 2008-06-03
// Comment   : [url]http://www.swissdelphicenter.ch/torry/showcode.php?id=1916[/url]
//             Integer support: Michael Puff
procedure TBSearch.QuickSort(var IntArray: TIntArray; Start, Stop: Integer);
var
  Left: Integer;
  Right: Integer;
  Mid: Integer;
  Pivot: Integer;
  Temp: Integer;
begin
  Left  := Start;
  Right := Stop;
  Mid   := (Start + Stop) div 2;

  Pivot := IntArray[mid];
  repeat
    while IntArray[Left] < Pivot do Inc(Left);
    while Pivot < IntArray[Right] do Dec(Right);
    if Left <= Right then
    begin
      Temp           := IntArray[Left];
      IntArray[Left]  := IntArray[Right]; // Swops the two Strings
      IntArray[Right] := Temp;
      Inc(Left);
      Dec(Right);
    end;
  until Left > Right;

  if Start < Right then QuickSort(IntArray, Start, Right); // Uses
  if Left < Stop then QuickSort(IntArray, Left, Stop);     // Recursion
end;

////////////////////////////////////////////////////////////////////////////////
// Procedure : TBSearch.QuickSort
// Author    : Derek van Daal
// Date      :
// Comment   : [url]http://www.swissdelphicenter.ch/torry/showcode.php?id=1916[/url]
procedure TBSearch.QuickSort(var Strings: TStrArray; Start, Stop: Integer);
var
  Left: Integer;
  Right: Integer;
  Mid: Integer;
  Pivot: string;
  Temp: string;
begin
  Left  := Start;
  Right := Stop;
  Mid   := (Start + Stop) div 2;

  Pivot := Strings[mid];
  repeat
    while Strings[Left] < Pivot do Inc(Left);
    while Pivot < Strings[Right] do Dec(Right);
    if Left <= Right then
    begin
      Temp           := Strings[Left];
      Strings[Left]  := Strings[Right]; // Swops the two Strings
      Strings[Right] := Temp;
      Inc(Left);
      Dec(Right);
    end;
  until Left > Right;

  if Start < Right then QuickSort(Strings, Start, Right); // Uses
  if Left < Stop then QuickSort(Strings, Left, Stop);     // Recursion
end;

////////////////////////////////////////////////////////////////////////////////
// Procedure : TBSearch.Search
// Author    : Michael Puff
// Date      : 2008-06-03
// Comment   : Returns index of element or -1
function TBSearch.Search(IntArray: TIntArray; x: Integer; Sorted: Boolean): Integer;
var
  left              : Integer;
  middle            : Integer;
  right             : Integer;
  found             : Boolean;
  index             : Integer;
begin
  if not Sorted then
    QuickSort(IntArray, 0, High(IntArray));

  found := False;
  index := -1;
  left := Low (IntArray);
  right := High(IntArray);

  while (left <= right) and (not Found) do
  begin
    middle := (left + right) div 2;
    if (IntArray[middle] = x) then
    begin
      index := middle;
      Found := True;
    end;
    if (IntArray[middle] > x) then
      right := middle - 1
    else
      left := middle + 1;
  end;

  result := index;
end;

////////////////////////////////////////////////////////////////////////////////
// Procedure : TBSearch.Search
// Author    : Michael Puff
// Date      : 2008-06-03
// Comment   : returns index of element or -1
//           : case sensitive
function TBSearch.Search(StrArray: TStrArray; s: String; Sorted: Boolean): Integer;
var
  left              : Integer;
  middle            : Integer;
  right             : Integer;
  found             : Boolean;
  index             : Integer;
begin
  if not Sorted then
    QuickSort(StrArray, 0, High(StrArray));

  found := False;
  index := -1;
  left := Low (StrArray);
  right := High(StrArray);

  while (left <= right) and (not Found) do
  begin
    middle := (left + right) div 2;
    if (StrArray[middle] = s) then
    begin
      index := middle;
      Found := True;
    end;
    if (StrArray[middle] > s) then
      right := middle - 1
    else
      left := middle + 1;
  end;

  result := index;
end;

end.

Stichworte: binäre Suche, binary search, Binärsuche, suchen, dynamische Arrays

[gammatester]

Bei der Integersuche wird doch der Teil if (right < left) then break nie ausgeführt, da left <= right, oder übersehe ich da was Offensichtliches? (Wahrscheinlich nicht, da der entstrechende Teil bei der Stringsuche nicht da ist.)

Gruß Gammatester

[Luckie]

Stimmt, das ist in die Abbruchbedingug der while-Schleife gewandert

[sx2008]

Wenn das Element nicht gefunden wurde, wäre es sinnvoll, den Index des nächst-kleineren Elements zurückzuliefern.
Wenn man dieses Element dann in das Array oder Liste einfügen möchte, dann kennt man die Einfügestelle und muss nicht neu sortieren.

Allerdings braucht man dann einen zusätzlichen Var- oder out-Parameter (boolean), um das Flag found zurückzugeben.
Mit überladenden Funktionen kann man Beides haben:

Delphi-Quellcode:

TBSearch = class(....
 function Search(IntArray: TIntArray; x: Integer; Sorted: Boolean; Out found:boolean): Integer;overload;
 function Search(IntArray: TIntArray; x: Integer; Sorted: Boolean): Integer;overload;
...
function TBSearch.Search(IntArray: TIntArray; x: Integer; Sorted: Boolean): Integer;
var
  found : Boolean;
begin
  result := Search(IntArray, x, Sorted, found);
  if not found then Result := -1;
end;

Dann muss man sich noch Gedanken machen, was passiert, sollte der Suchschlüssel kleiner als das erste Arrayelement oder grösser als das letzte Arrayelement sein.
Man müsste dazu den Parameter found umdefinieren:

Delphi-Quellcode:

type
  TBSFound = (bsFound {gefunden}, bsNotFound {nicht gefunden}, bsLower, bsHigher);
...
 function Search(IntArray: TIntArray; x: Integer; Sorted: Boolean; Out found:TBSFound): Integer;overload;

[Apollonius]

Sollten das nicht eher Klassenmethoden sein?

[sx2008]

Zitat von Apollonius:

Sollten das nicht eher Klassenmethoden sein?

Im Moment vielleicht schon; die Klasse TBSearch hat z.Zt. nur die Aufgabe den Code zusammenzuhalten.
Aber das könnte sich ändern.
Das Grundlegende an der Binären Suche ist doch, dass ein beliebiges Element aus einem Array mit einem Schlüssel verglichen wird.
Diesen Vergleich könnte man in eine virtuelle Methode auslagern, so dass der Algorithmus für alle denkbaren Datentypen erweiterbar ist.
Die Basisklasse sieht dann so aus (ungetestet):

Delphi-Quellcode:

TBSearch = class(TObject)
  private
    FSorted : Boolean;
  protected
    FLeft  : Integer;   // untere Grenze der Daten (meist 0)
    FRight : Integer;   // obere Grenze der Daten
    // Rückgabewert von KeyCompare()
    // Key < daten[index]  => -1  (negative Zahl)
    // Key = daten[index]  =>  0
    // Key > daten[index]  => +1  (positive Zahl)
    function KeyCompare(index:integer):integer;virtual;abstract;   
  public
    procedure QuickSort(Start, Stop: Integer);
    function Search: Integer; overload;
    function Search(out found:TBFound): Integer; overload;
    property Sorted : Boolean read FSorted;
  end;

Für jeden Datentyp, nach dem man suchen möchte, muss eine eigene Klasse abgeleitet werden.
Hier ein Beispiel für Integer:

Delphi-Quellcode:

TIntArray = array of Integer;
TBSearchInteger = class(TBSearch)
private
   FData : TIntArray;
   procedure SetData(const value:TIntArray);
protected
   function KeyCompare(index:integer):integer;override;
public
   Key : Integer;  // der Wert nach dem gesucht werden soll
   property Data : TIntArray read FData write SetData(value:TIntArray);  // die Daten
end;

procedure TBSearchInteger.SetData(const value:TIntArray);
begin
  FLeft := Low(value);   // untere 
  FRight:= High(value);  // und obere Grenze merken
  FData := value;
end;

function TBSearchInteger.KeyCompare(index:integer):integer;
begin
  if Key < FData[index] then Result := -1
  else if Key > FData[index] then Result := 1
  else Result := 0;
  // möglich wäre auch: Result := Key - FData[index]
end;

Jetzt ergibt sich aber das Problem, das Quicksort nicht mehr funktioniert,
denn Quicksort hat zwei Grundoperationen: Vergleichen und Tauschen.
Also brauchen wir zwei weitere virtuelle Methoden in der Basisklasse:

Delphi-Quellcode:

function Compare(a,b:integer):integer;virtual;abstract;  // vergleiche Element A mit B
procedure Exchange(a,b:integer);virtual;abstract; // tausche Element A mit B

Das war jetzt vielleicht ein bißchen viel auf einmal, drum höre ich jetzt auf. 8)

[Luckie]

Ich habe im moment nicht die rechte Zeit dazu an meinem ursprünglichen Code weiter zu arbeiten. aber wenn ihr wollt könnt ihr gerne meinen Code nehmen und eure Verbesserungsvorschläge einarbeiten.

[Andreas H.]

Hallo,

gefällt mir gut. Sowas wollte ich immer schon mal schreiben/haben

Wäre ein schönes kleines Sommerprojekt. Hätte schon Lust, was draus zu machen. Wir ziehen leider demnächst um. Im Herbst vielleicht...


Gruß Andreas

[sx2008]

Ich habe die vorgeschlagenen Änderungen zu einem Demo zusammengestellt.
Es ist jeweils eine Klasse zum Suchen & Sortieren von Integer-Array und TStrings dabei.
Durch Ableiten der Basisklasse kann man alles suchen & sortieren, was sich irgendwie als Array oder Liste darstellen lässt.

[alzaimar]

Der erweiterte Parameter Found wird so nicht benötigt. Es reicht, TRUE bzw. FALSE zu liefern sowie die Position, VOR der das Element eingefügt werden kann. Dieser Wert liegt zwischen Low(Array) bis High(Array)+1. So steht es jedenfalls in der Literatur... In meiner BTree-Klasse verwende ich folgenden Code;

Delphi-Quellcode:

function Search(const aItem: TElement; AArray: TElementArray; var aIndex: Integer): Boolean;
var
  L, R, M: integer; // Für Left, Right, Middle

begin
  L := Low(AArray);
  R := High(AArray);
  while (L <= R) do begin
    M := (L + R) div 2;
    case CompareItems(aItem, AArray[M]) of
      coComparedLess:
        R := M - 1;
      coComparedEqual: begin
          Result := True;
          aIndex := M;
          Exit;
        end;
      coComparedGreater:
        L := M + 1
    end;
  end;
  aIndex := L;
  Result := False;
end;

Die Funktion liefert TRUE sowie in aIndex die Position, wenn das Element aItem in AArray gefunden wurde bzw FALSE, wenn das Element nicht gefunden wurde. In diesem Fall bezeichnet aIndex die Position, an der das Element im AArray eingefügt werden könnte.

[edit] Code korrigiert [/edit]