utils/uutlAlgorithm.pas

unit uutlAlgorithm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlInterfaces;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlBinarySearch<T> = class
  public type
    IReadOnlyArray  = specialize IutlReadOnlyArray<T>;
    IComparer       = specialize IutlComparer<T>;
    PT              = ^T;

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

  public
    // search aItem in aArray using aComparer
    // aList needs to bee sorted
    // aIndex is the index the item was found or should be inserted
    // returns TRUE when found, FALSE otherwise
    class function Search(
      constref aArray: IReadOnlyArray;
      constref aComparer: IComparer;
      constref aItem: T;
      out aIndex: Integer): Boolean; overload;

    // search aItem in aList using aComparer
    // aList needs to bee sorted
    // aIndex is the index the item was found or should be inserted
    // returns TRUE when found, FALSE otherwise
    class function Search(
      const aArray;
      const aCount: Integer;
      constref aComparer: IComparer;
      constref aItem: T;
      out aIndex: Integer): Boolean; overload;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlQuickSort<T> = class
  public type
    IArray    = specialize IutlArray<T>;
    IComparer = specialize IutlComparer<T>;
    PT        = ^T;

  private
    class procedure DoSort(
      constref aArray: IArray;
      constref aComparer: IComparer;
      aLow: Integer;
      aHigh: Integer); overload;

    class procedure DoSort(
      constref aArray: PT;
      constref aComparer: IComparer;
      aLow: Integer;
      aHigh: Integer); overload;

  public
    class procedure Sort(
      constref aArray: IArray;
      constref aComparer: IComparer); overload;
    class procedure Sort(
      var aArray: T;
      constref aCount: Integer;
      constref aComparer: IComparer); overload;
  end;

implementation

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(
  constref aArray: IReadOnlyArray;
  constref aComparer: IComparer;
  constref aItem: T;
  out aIndex: Integer): Boolean;
begin
  if not Assigned(aComparer) then
    raise EArgumentNilException.Create('aComparer');
  result := DoSearch(aArray, aComparer, 0, aArray.Count-1, aItem, aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(
  const aArray;
  const aCount: Integer;
  constref aComparer: IComparer;
  constref aItem: T;
  out aIndex: Integer): Boolean;
begin
  if not Assigned(aComparer) then
    raise EArgumentNilException.Create('aComparer');
  result := DoSearch(@aArray, aComparer, 0, aCount-1, aItem, aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQuickSort/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.DoSort(
  constref aArray: IArray;
  constref aComparer: IComparer;
  aLow: Integer;
  aHigh: Integer);
var
  lo, hi: Integer;
  p: T;
begin
  while (aLow < aHigh) do begin
    lo := aLow;
    hi := aHigh;
    p  := aArray[(aLow + aHigh) div 2];
    repeat
      while (aComparer.Compare(p, aArray[lo]) > 0) and (lo < aHigh) do
        lo := lo + 1;
      while (aComparer.Compare(p, aArray[hi]) < 0) and (hi > aLow) do
        hi := hi - 1;
      if (lo <= hi) then begin
        aArray.Exchange(lo, hi);
        lo := lo + 1;
        hi := hi - 1;
      end;
    until (lo > hi);

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.DoSort(
  constref aArray: PT;
  constref aComparer: IComparer;
  aLow: Integer;
  aHigh: Integer);
var
  lo, hi: Integer;
  p, tmp: T;
begin
  if not Assigned(aArray) then
    raise EArgumentNilException.Create('aArray');

  while (aLow < aHigh) do begin
    lo := aLow;
    hi := aHigh;
    p  := aArray[(aLow + aHigh) div 2];
    repeat
      while (aComparer.Compare(p, aArray[lo]) > 0) and (lo < aHigh) do
        lo := lo + 1;
      while (aComparer.Compare(p, aArray[hi]) < 0) and (hi > aLow) do
        hi := hi - 1;
      if (lo <= hi) then begin
        tmp := aArray[lo];
        aArray[lo] := aArray[hi];
        aArray[hi] := tmp;
        lo := lo + 1;
        hi := hi - 1;
      end;
    until (lo > hi);

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.Sort(
  constref aArray: IArray;
  constref aComparer: IComparer);
begin
  if not Assigned(aComparer) then
    raise EArgumentNilException.Create('aComparer');
  DoSort(aArray, aComparer, 0, aArray.GetCount-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.Sort(
  var aArray: T;
  constref aCount: Integer;
  constref aComparer: IComparer);
begin
  if not Assigned(aComparer) then
    raise EArgumentNilException.Create('aComparer');
  DoSort(@aArray, aComparer, 0, aCount-1);
end;

end.