GenHelpers.pas

unit GenHelpers;

{ **************************************************************************** }
{ Rejbrand AlgoSim generic helper types                                        }
{ Copyright © 2017-2019 Andreas Rejbrand                                       }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

interface

uses
  SysUtils, Generics.Defaults, Math;

type
  TObjProc = procedure of object;

  TTable<T> = array of TArray<T>;

  TSwapper<T> = record
    class procedure Swap(var A: T; var B: T); static; inline;
  end;

  TShuffler<T> = record
    class procedure Shuffle(var Arr: TArray<T>); static;
  end;

  TReverser<T> = record
    class procedure Reverse(var Arr: TArray<T>); static;
  end;

  TMover<T: class> = record
    class procedure Move(var ATo, AFrom: T); static; inline;
    class procedure ReplaceMove(var ATo, AFrom: T); static; inline;
  end;

  TObjReplacer<T: class> = record
    class procedure Replace(var AObject: T; NewObject: T); static; inline;
  end;

  TArrBuilder<T> = record
    class procedure Add(var Arr: TArray<T>; Val: T); static; inline;
    class procedure AddUnique(var Arr: TArray<T>; Val: T); static;
  end;

  TArrExtender<T> = record
    class procedure Extend(var Arr: TArray<T>;
      const Extension: TArray<T>); static; inline;
  end;

  TArrInserter<T> = record
    class procedure Insert(var Arr: TArray<T>; AIndex: Integer;
      const Val: T); static; inline;
  end;

  TZeroer<T> = record
    class procedure Zero(var Arr: TArray<T>); static; inline;
  end;

  TRemover<T> = record
  private
    class procedure DoRemove(var Arr: TArray<T>;
      const AIndices: array of Integer;
      AFree: Boolean = False); static;
    class procedure DoRemoveFirst(var Arr: TArray<T>; N: Integer = 1;
      AFree: Boolean = False); static;
  public
    class procedure Remove(var Arr: TArray<T>;
      const AIndices: array of integer); static;
    class procedure RemoveFirst(var Arr: TArray<T>; N: Integer = 1); static;
  end;

  TObjRemover<T: class> = record
    class procedure Remove(var Arr: TArray<T>;
      const AIndices: array of Integer); static;
    class procedure RemoveFirst(var Arr: TArray<T>; N: Integer = 1); static;
  end;

  TSafeSorter<T> = record
  private
    class function Partition(var AArray: TArray<T>; a, b: Integer;
      AComparer: IComparer<T>): Integer; static;
    class procedure QuickSort(var AArray: TArray<T>; a, b: Integer;
      AComparer: IComparer<T>); static;
  public
    class procedure Sort(var AArray: TArray<T>; AComparer: IComparer<T>); static;
  end;

procedure FreeAndNil(var X);

implementation

procedure FreeAndNil(var X);
begin
  var Obj := TObject(X);
  Pointer(X) := nil;
  Obj.Free;
end;

{ TSwapper<T> }

class procedure TSwapper<T>.Swap(var A: T; var B: T);
var
  Tmp: T;
begin
  Tmp := A;
  A := B;
  B := Tmp;
end;

{ TShuffler<T> }

class procedure TShuffler<T>.Shuffle(var Arr: TArray<T>);
var
  i: Integer;
begin
  for i := High(Arr) downto 1 do
    TSwapper<T>.Swap(Arr[i], Arr[Random(Succ(i))]);
end;

{ TReverser<T> }

class procedure TReverser<T>.Reverse(var Arr: TArray<T>);
var
  b, e: Integer;
begin
  b := 0;
  e := High(Arr);
  while b < e do
  begin
    TSwapper<T>.Swap(Arr[b], Arr[e]);
    Inc(b);
    Dec(e);
  end;
end;

{ TMover<T> }

class procedure TMover<T>.Move(var ATo, AFrom: T);
begin
  ATo := AFrom;
  AFrom := nil;
end;

class procedure TMover<T>.ReplaceMove(var ATo, AFrom: T);
var
  OldObj: T;
begin
  OldObj := ATo;
  ATo := AFrom;
  AFrom := nil;
  OldObj.Free;
end;

{ TArrBuilder<T> }

class procedure TArrBuilder<T>.Add(var Arr: TArray<T>; Val: T);
begin
  SetLength(Arr, Succ(Length(Arr)));
  Arr[High(Arr)] := Val;
end;

class procedure TArrBuilder<T>.AddUnique(var Arr: TArray<T>; Val: T);
begin
  if (Length(Arr) = 0) or (TComparer<T>.Default.Compare(Arr[High(Arr)], Val) <> 0) then
  begin
    SetLength(Arr, Succ(Length(Arr)));
    Arr[High(Arr)] := Val;
  end;
end;

{ TZeroer<T> }

class procedure TZeroer<T>.Zero(var Arr: TArray<T>);
begin
  if Length(Arr) > 0 then
    FillChar(Arr[0], Length(Arr) * sizeof(T), 0);
end;

{ TArrExtender<T> }

class procedure TArrExtender<T>.Extend(var Arr: TArray<T>;
  const Extension: TArray<T>);
var
  OldLength: Integer;
begin
  OldLength := Length(Arr);
  SetLength(Arr, OldLength + Length(Extension));
  if Length(Extension) > 0 then
    Move(Extension[0], Arr[OldLength], Length(Extension) * sizeof(T));
end;

{ TArrInserter<T> }

class procedure TArrInserter<T>.Insert(var Arr: TArray<T>; AIndex: Integer;
  const Val: T);
begin
  if not InRange(AIndex, 0, Length(Arr)) then
    raise Exception.Create('Index out of range.');
  SetLength(Arr, Length(Arr) + 1);
  if AIndex < High(Arr) then
    Move(Arr[AIndex], Arr[AIndex + 1], (High(Arr) - AIndex) * sizeof(T));
  Arr[AIndex] := Val;
end;

{ TRemover<T> }

class procedure TRemover<T>.DoRemove(var Arr: TArray<T>;
  const AIndices: array of Integer; AFree: Boolean);
var
  RemoveFlags: array of boolean;
  i, j, NewLen: Integer;
  NewArr: TArray<T>;
begin
  SetLength(RemoveFlags, Length(Arr));
  for i := 0 to High(AIndices) do
    if InRange(AIndices[i], 0, High(Arr)) then
      RemoveFlags[AIndices[i]] := True;
  NewLen := Length(Arr);
  for i := 0 to High(RemoveFlags) do
    if RemoveFlags[i] then
    begin
      Dec(NewLen);
      if AFree then
        FreeAndNil(Arr[i]);
    end;
  SetLength(NewArr, NewLen);
  j := 0;
  for i := 0 to High(Arr) do
    if not RemoveFlags[i] then
    begin
      NewArr[j] := Arr[i];
      Inc(j);
    end;
  Arr := NewArr;
end;

class procedure TRemover<T>.DoRemoveFirst(var Arr: TArray<T>; N: Integer;
  AFree: Boolean);
var
  i: Integer;
begin
  if N < 1 then
    Exit;
  if AFree then
    for i := 0 to Min(N - 1, High(Arr)) do
      FreeAndNil(Arr[i]);
  if Length(Arr) > N then
    Move(Arr[N], Arr[0], (Length(Arr) - N) * sizeof(Arr[0]));
  SetLength(Arr, Math.Max(0, Length(Arr) - N));
end;

class procedure TRemover<T>.Remove(var Arr: TArray<T>;
  const AIndices: array of Integer);
begin
  DoRemove(Arr, AIndices);
end;

class procedure TRemover<T>.RemoveFirst(var Arr: TArray<T>; N: Integer);
begin
  DoRemoveFirst(Arr, N);
end;

{ TObjRemover<T> }

class procedure TObjRemover<T>.Remove(var Arr: TArray<T>;
  const AIndices: array of Integer);
begin
  TRemover<T>.DoRemove(Arr, AIndices, True);
end;

class procedure TObjRemover<T>.RemoveFirst(var Arr: TArray<T>; N: Integer);
begin
  TRemover<T>.DoRemoveFirst(Arr, N, True);
end;

{ TObjReplacer<T> }

class procedure TObjReplacer<T>.Replace(var AObject: T; NewObject: T);
var
  OldObject: T;
begin
  OldObject := AObject; {noexcept}
  AObject := NewObject; {transfer of ownership, noexcept}
  OldObject.Free;
end;

{ TSafeSorter<T> }

class function TSafeSorter<T>.Partition(var AArray: TArray<T>;
  a, b: Integer; AComparer: IComparer<T>): Integer;
begin
  var p := AArray[b];
  Result := a - 1;
  for var j := a to b - 1 do
    if AComparer.Compare(AArray[j], p) <= 0 then
    begin
      Inc(Result);
      TSwapper<T>.Swap(AArray[Result], AArray[j]);
    end;
  Inc(Result);
  TSwapper<T>.Swap(AArray[Result], AArray[b]);
end;

class procedure TSafeSorter<T>.QuickSort(var AArray: TArray<T>; a, b: Integer;
  AComparer: IComparer<T>);
begin
  if not InRange(a, 0, High(AArray)) or not InRange(b, 0, High(AArray)) or (a >= b) then
    Exit;
  var p := Partition(AArray, a, b, AComparer);
  QuickSort(AArray, a, p - 1, AComparer);
  QuickSort(AArray, p + 1, b, AComparer);
end;

class procedure TSafeSorter<T>.Sort(var AArray: TArray<T>; AComparer: IComparer<T>);
begin
  QuickSort(AArray, 0, High(AArray), AComparer);
end;

end.