utils/uutlAlgorithm.pas

unit uutlAlgorithm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlInterfaces;

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

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

  public
    // search aItem in aIndexer using aComparer
    // aIndex is the index the item was found or should be inserted
    // returns TRUE when found, FALSE otherwise
    class function Search(
      constref aIndexer: IReadOnlyIndexer;
      constref aComparer: IComparer;
      constref aItem: T;
      out aIndex: Integer): Boolean;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean; overload;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
begin
  result := Assigned(aInstance) and aInstance.InheritsFrom(aClass);
  if result then
    TObject(aObj) := aInstance
  else
    TObject(aObj) := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlBinarySearch//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.DoSearch(
  constref aIndexer: IReadOnlyIndexer;
  constref 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, aIndexer.Items[i]);
    if (cmp = 0) then begin
      result := true;
      aIndex := i;
    end else if (cmp < 0) then
      result := DoSearch(aIndexer, aComparer, aMin, i-1, aItem, aIndex)
    else if (cmp > 0) then
      result := DoSearch(aIndexer, aComparer, i+1, aMax, aItem, aIndex);
  end else begin
    result := false;
    aIndex := aMin;
  end;
end;

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

end.