Combinations by slacky

{$loadlib pumbaa.dll}

{*
Combinations of size `seq` from given TIA `arr`.
*}
function TIACombinationsNew(arr: TIntegerArray; sequence: Integer): T2DIntegerArray;
var
  n, h, i, j: Integer;
  o: TIntegerArray;
  b: Boolean;
begin
  n := Length(arr);
  if (sequence < n) then
  begin
    SetLength(o, sequence);
    for i := 0 to (sequence - 1) do
      o[i] := i;
    SetLength(Result, 1, sequence);
    for i := 0 to (sequence - 1) do
      Result[0][i] := arr[i];
    repeat
      for i := (sequence - 1) downto 0 do
      begin
        b := not (o[i] <> (i + n - sequence));
        if not b then
        begin
          o[i] := (o[i] + 1);
          for j := (i + 1) to (sequence - 1) do
            o[j] := (o[(j - 1)] + 1);
          h := Length(Result);
          SetLength(Result, (h + 1));
          SetLength(Result[h], sequence);
          for j := 0 to (sequence - 1) do
            Result[h][j] := arr[o[j]];
          Break;
        end;
      end;
    until b;
  end else
    if (n > 0) then
    begin
      SetLength(Result, 1);
      SetLength(Result[0], n);
      for i := 0 to (n - 1) do
        Result[0][i] := arr[i];
    end else
      SetLength(Result, 0);
end;

function TIACombinationsOld(arr: TIntegerArray; sequence: Integer): T2DIntegerArray;
var
  n, h, i, j: Integer;
  o: TIntegerArray;
  b: Boolean;
begin
  n := Length(arr);
  if (sequence < n) then
  begin
    SetLength(o, sequence);
    for i := 0 to (sequence - 1) do
      o[i] := i;
    SetLength(Result, 1, sequence);
    for i := 0 to (sequence - 1) do
      Result[0][i] := arr[i];
    repeat
      b := True;
      for i := (sequence - 1) downto 0 do
      begin
        b := not (o[i] <> (i + n - sequence));
        if not b then
          Break;
      end;
      if b then
        Exit;
      o[i] := (o[i] + 1);
      for j := (i + 1) to (sequence - 1) do
        o[j] := (o[(j - 1)] + 1);
      h := Length(Result);
      SetLength(Result, (h + 1));
      SetLength(Result[h], sequence);
      for i := 0 to (sequence - 1) do
        Result[h][i] := arr[o[i]];
    until False;
  end else
    if (n > 0) then
    begin
      SetLength(Result, 1);
      SetLength(Result[0], n);
      for i := 0 to (n - 1) do
        Result[0][i] := arr[i];
    end else
      SetLength(Result, 0);
end;

function TIACombinations(const Arr:TIntegerArray; Seq:Integer): T2DIntegerArray;
var
  n,h,i,j: Integer;
  indices: TIntegerArray;
  breakout: Boolean;
begin
  n := Length(arr);
  if seq > n then Exit;
  SetLength(indices, seq);
  for i:=0 to (seq-1) do indices[i] := i;
  SetLength(Result, 1, Seq);
  for i:=0 to (seq-1) do Result[0][i] := arr[i];
  while True do
  begin
    breakout := True;
    for i:=(Seq-1) downto 0 do
      if (indices[i] <> (i + n - Seq)) then begin
        breakout := False;
        Break;
      end;
    if breakout then Exit;
    Indices[i] := Indices[i]+1;
    for j:=i+1 to Seq-1 do
      Indices[j] := (Indices[j-1] + 1);
    h := Length(Result);
    SetLength(Result, h+1);
    SetLength(Result[h], Seq);
    for i:=0 to Seq-1 do
      Result[h][i] := Arr[Indices[i]];
  end;
  SetLength(Indices, 0);
end;

var
  TIA: TIntegerArray;
  ATIA: T2DIntegerArray;
  i: Integer;

begin
  ClearDebug;
  pp_TIAByRangeWrap(-100, 100, TIA);
  i := GetSystemTime;
  ATIA := TIACombinationsNew(TIA, 3);
  WriteLn('NEW Calculated ' +ToStr(Length(ATIA))+ ' groups in ' + ToStr(GetSystemTime - i) + 'ms');
  SetLength(ATIA, 0);
  i := GetSystemTime;
  ATIA := TIACombinationsOld(TIA, 3);
  WriteLn('OLD Calculated ' +ToStr(Length(ATIA))+ ' groups in ' + ToStr(GetSystemTime - i) + 'ms');
  SetLength(ATIA, 0);
  i := GetSystemTime;
  ATIA := TIACombinations(TIA, 3);
  WriteLn('ORI Calculated ' +ToStr(Length(ATIA))+ ' groups in ' + ToStr(GetSystemTime - i) + 'ms');
  SetLength(ATIA, 0);
end.