utils/uutlAlgorithm.pas

unit uutlAlgorithm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlInterfaces;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlQuickSort<T> = class(TObject)
  public type
    IList     = specialize IutlList<T>;
    IComparer = specialize IutlComparer<T>;

  private
    class procedure DoSort(
      aList: IList;
      aComparer: IComparer;
      aLow: Integer;
      aHigh: Integer);

  public
    class procedure Sort(
      aList: IList;
      aComparer: IComparer);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlBinarySearch<T> = class(TObject)
  public type
    IList     = specialize IutlReadOnlyList<T>;
    IComparer = specialize IutlComparer<T>;

  private
    class function DoSearch(
      aList: IList;
      aComparer: IComparer;
      const aMin: Integer;
      const aMax: Integer;
      constref aItem: T;
      out aIndex: Integer): Boolean;

  public
    class function Search(
      aList: IList;
      aComparer: IComparer;
      constref aItem: T;
      out aIndex: Integer): Boolean;
  end;

implementation

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQuickSort//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.DoSort(aList: IList; aComparer: IComparer; aLow: Integer; aHigh: Integer);
var
  lo, hi: Integer;
  p, tmp: T;
begin
  repeat
    lo := aLow;
    hi := aHigh;
    p  := aList.GetItem((aLow + aHigh) div 2);
    repeat
      while (aComparer.Compare(p, aList.GetItem(lo)) > 0) do
        lo := lo + 1;
      while (aComparer.Compare(p, aList.GetItem(hi)) < 0) do
        hi := hi - 1;
      if (lo <= hi) then begin
        tmp := aList.GetItem(lo);
        aList.SetItem(lo, aList.GetItem(hi));
        aList.SetItem(hi, tmp);
        lo := lo + 1;
        hi := hi - 1;
      end;
    until (lo > hi);

    if (hi - aLow < aHigh - lo) then begin
      if (aLow < hi) then
        DoSort(aList, aComparer, aLow, hi);
      aLow := lo;
    end else begin
      if (lo < aHigh) then
        DoSort(aList, aComparer, lo, aHigh);
      aHigh := hi;
    end;
  until (aLow >= aHigh);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.Sort(aList: IList; aComparer: IComparer);
begin
  DoSort(aList, aComparer, 0, aList.GetCount-1);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlBinarySearch///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.DoSearch(aList: IList; aComparer: IComparer; const aMin: Integer; const aMax: Integer;
  constref aItem: T; out aIndex: Integer): Boolean;
var
  i, cmp: Integer;
begin
  if (aMin <= aMax) then begin
    i   := aMin + Trunc((aMax - aMin) / 2);
    cmp := aComparer.Compare(aItem, aList.GetItem(i));
    if (cmp = 0) then begin
      result := true;
      aIndex := i;
    end else if (cmp < 0) then
      result := DoSearch(aList, aComparer, aMin, i-1, aItem, aIndex)
    else if (cmp > 0) then
      result := DoSearch(aList, aComparer, i+1, aMax, aItem, aIndex);
  end else begin
    result := false;
    aIndex := aMin;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(aList: IList; aComparer: IComparer; constref aItem: T;
  out aIndex: Integer): Boolean;
begin
  result := DoSearch(aList, aComparer, 0, aList.GetCount-1, aItem, aIndex);
end;

end.