ucombov2.pas

Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati

      Dec(Count);
    end;
    CombinationsRepeatDown:
    begin
      Result := PrevLexRepRCombo;
      Dec(Count);
    end;
    PermutationsRepeatDown :
    begin
      Result := PrevLexRepRPermute;{Lexicographical order down}
      Dec(Count);
    end;
    else
    begin
      Result := False
    end;            {Error}
  end;
end;

function TComboSet.PrevCoLexRCombo: boolean;
var
  i, k: integer;
begin
  if Selected[r] <= r then        {check to see if final combination}
  begin
    Result := False;
    exit;
  end;
  Result := True;
  i      := 1;
  while (i = Selected[i]) do     {walk down tree}
  begin
    Inc(i)
  end;
  Dec(Selected[i]);              {setup temp variable to speed up calculation}
  k := Selected[i];
  while i > 1 do                 {reset values}
  begin
    Dec(i);                       {loop variable}
    Dec(k);                       {use temporary variable for speed}
    Selected[i] := k;
  end;
end;

function TComboSet.PrevLexRCombo: boolean;
var
  i, k: integer;
begin
  Result := True;                              {set default value}
  k      := r;                                 {assign local variable for speed}
  while (Selected[k] - Selected[k - 1]) = 1 do {walk down chain}
  begin
    Dec(k)
  end;
  if k <= 0 then                               {check for last combination}
  begin
    Result := False;
    exit;
  end;
  Dec(Selected[k]);                            {decrease value}
  i := n - r + k;                              {temp variable to speed up calc}
  while k < r do                               {set remaining values}
  begin
    Inc(k);
    Inc(i);                                    {use temp variable for speed}
    Selected[k] := i;
  end;
end;

function TComboSet.PrevLexRepRCombo: boolean;
var
  i, k: integer;
begin
  Result := True;                              {set default value}
  k      := r;                                 {assign local variable for speed}
  while (Selected[k] = Selected[k - 1]) do {walk down chain}
  begin
    Dec(k)
  end;
  if k <= 1 then                               {check for last combination}
  begin
    K := 1;
    if selected[k] <= 1 then
    begin
      Result := False;
      exit;
    end;
  end;
  Dec(Selected[k]);                            {decrease value}
  i := n;                                      {temp variable to speed up calc}
  while k < r do                               {set remaining values}
  begin
    Inc(k);
    Selected[k] := i;
  end;
end;


function TComboSet.PrevLexRepRPermute: boolean;
var
  i, k: integer;
begin
  Result := True;
  k      := r;
  if Selected[k] > 1 then                     {see if can lower last value}
  begin
    Dec(Selected[r]);
    exit;
  end;
  while (Selected[k] = Selected[k - 1]) do     {walk down tree}
  begin
    Dec(k)
  end;
  if k = 1 then                              {check for last permutation}
  begin
    Result := False;
    exit;
  end;
  Dec(Selected[k - 1]);                       {decrease by 1}
  for i := k to r do
  begin
    Selected[i] := n
  end;                         {reset value to top value}
end;

function TComboSet.PrevLexRPermute: boolean;
var
  j, k, IncPos, il: integer;
label
  BreakDoLoop;
begin
  Result := True;          {Default value}
  IncPos := r;             {start at end and work to front}
  while True do
  begin
    for il := Selected[IncPos] - 1 downto 1 do
    begin
      if Loops[il] <> 1 then           {we found a unused pos}
      begin
        Loops[Selected[IncPos]] := 0;  {mark old pos as unused}
        Loops[il] := 1;                {mark new pos as used}
        Selected[IncPos] := il;        {place new value in Selected}
        goto BreakDoLoop;              {break}
      end
    end;
    if IncPos > 1 then                 {back-up one position and repeat}
    begin
      Loops[Selected[IncPos]] := 0;    {mark old pos as unused}
      Dec(IncPos);                     {look to increase previous place}
    end
    else
    begin
      Result := False;  {reached end of permutation}
      exit;
    end;
  end;
  BreakDoLoop:
    if IncPos < r then        {then we have more sequences to place}
    begin
      k := n;
      for j := IncPos + 1 to r do
      begin
        while Loops[k] = 1 do
        begin
          Dec(k)
        end;
        { unroll this loop for speed ...}
        Selected[j] := k;
        Loops[k]    := 1;   {mark as used}
        Dec(k);
      end;
    end;
end;

 {******************** Rank Functions ********************}
 {Functions to Return Rank position in Selected array}
function TComboSet.RankR: int64;
begin
  Result := 0;
  if IsValidRSequence then
  begin
    case Ctype of
      Combinations, CombinationsDown:
        Result := RankLexRCombo;
      Permutations,PermutationsDown:
        Result := RankLexRPermute;
      CombinationsCoLex,CombinationsCoLexDown:
        Result := RankCoLexRCombo;
      PermutationsRepeat, PermutationsWithrep,PermutationsRepeatDown:
        Result := RankLexRepRPermute;
      CombinationsRepeat,CombinationsWithrep,CombinationsRepeatDown:
        Result := RankLexRepRCombo;
      else
        Result := 0;
    end
  end;
end;

function TComboSet.RankCoLexRCombo: int64;
var
  i, k: integer;
begin
  if not IsValidRSequence then
  begin
    Result := 0;
    exit;
  end;
  Result := 1; {Rank start at 1 not 0}
  for i := 1 to r do
  begin
    k      := r + 1 - i;
    Result := Result + Binomial(k, Selected[k] - 1);
  end;
  If ctype=CombinationsColexdown then result:=getcount+1-result;
end;

function TComboSet.RankLexRCombo: int64;
var
  i, j: integer;
begin
  if not IsValidRSequence then
  begin
    Result := 0;
    exit;
  end;
  Result      := 1;  {Rank start at 1 not 0}
  Selected[0] := 0;  {force to zero}
  for i := 1 to r do
  begin
    for j := Selected[i - 1] + 1 to Selected[i] - 1 do
    begin
      Result := Result + Binomial(r - i, n - j);
    end
  end;
end;

function TComboSet.RankLexRepRCombo: int64;
var
  DistinctNo, i, j : integer;
begin
  if not IsValidRSequence then
  begin
    Result := 0;
    exit;
  end;
  Result := 1;  {Rank start at 1 not 0}
  Selected[0] := 1;
  DistinctNo := n;
  for i := 1 to r - 1 do
  begin
    for j := Selected[i-1]+1 to Selected[i] do
    begin
      Result := Result + GetRepRCombo(r-i,DistinctNo);
      dec(DistinctNo);
    end;
  end;
  Result := Result + Selected[r]-Selected[r-1];
  Selected[0] := 0;
end;

function TComboSet.RankLexRPermute: int64;
var
  i, k, UnusedCount, CurrentNum: integer;
  TempLoops: Bytearray;
  imult:     int64;
begin
  if not IsValidRSequence then
  begin
    Result := 0;
    exit;
  end;
  Result := 1;  {Rank start at 1 not 0}
  FillChar(TempLoops, SizeOf(TempLoops), 0); {quick clear}
  imult := GetRPermute(r, n) div n;       {find multiplier for round}
  for i := 1 to r - 1 do
  begin
    {find "round" travel distance in permutation}
    UnusedCount := 0;
    CurrentNum  := Selected[i];    {temp variable for speed}
    for k := 1 to CurrentNum - 1 do
    begin
      if TempLoops[k] <> 1 then
      begin
        Inc(UnusedCount)
      end
    end;          {number of unused values}
    TempLoops[CurrentNum] := 1;    {mark value as used}
    Result := Result + UnusedCount * imult; {rank = distance * multiplier of round}
    imult  := imult div (n - i);   {find multiplier for next round}
  end;
  {find last "round" travel distance in permutation}
  UnusedCount := 0;
  for k := 1 to Selected[r] - 1 do
  begin
    if TempLoops[k] <> 1 then
    begin
      Inc(UnusedCount)
    end
  end; {number of unused values}
  Result := Result + UnusedCount;
  If ctype=permutationsdown then result:=getcount+1-result;
end;

function TComboSet.RankLexRepRPermute: int64;
var
  i: integer;
begin
  if not IsValidRSequence then
  begin
    Result := 0;
    exit;
  end;
  Result := 1;  {Rank start at 1 not 0}
  for i := r downto 1 do
  begin
    Result := Result + GetRepRPermute(r - i, n) * (Selected[i] - 1)
  end;
  If ctype=permutationsRepeatdown then result:=getcount+1-result;
end;

{******************** Directional Function ********************}
function TComboSet.GetNextPrevR: boolean;
begin {GetNextPrevR}
  case Ctype of
    Combinations:
    begin
      Result := NextLexRCombo;    {Lexicographical order up}
      Inc(Count);
    end;
    Permutations:
    begin
      Result := NextLexRPermute;  {Lexicographical order up}
      Inc(Count);
    end;
    CombinationsDown:
    begin
      Result := PrevLexRCombo;    {Lexicographical order down}
      Dec(Count);
    end;
    PermutationsDown:
    begin
      Result := PrevLexRPermute;  {Lexicographical order down}
      Dec(Count);
    end;
    CombinationsCoLex:
    begin
      Result := NextCoLexRCombo;  {Co-Lexicographical order up}
      Inc(Count);
    end;
    CombinationsCoLexDown:
    begin
      Result := PrevCoLexRCombo;  {Co-Lexicographical order down}
      Dec(Count);
    end;
    PermutationsRepeat, PermutationsWithRep:
    begin
      Result := NextLexRepRPermute;{Lexicographical order up}
      Inc(Count);
    end;
    PermutationsRepeatDown:
    begin
      Result := PrevLexRepRPermute;{Lexicographical order down}
      Dec(Count);
    end;
    CombinationsRepeat,CombinationsWithrep:
    begin
      Result := NextLexRepRCombo;{Lexicographical order up}
      Inc(Count);
    end;
    CombinationsRepeatDown:
    begin
      Result := PrevLexRepRCombo;{Lexicographical order down}
      Dec(Count);
    end;
    else
    begin
      Result := False
    end;
  end;
end;

{******************** Setup Procedures ********************}
procedure TComboSet.SetupR(NewR, NewN: word; NewCtype: TComboType);
begin
  n := NewN;
  if n < 1 then
  begin
    n := 0 {1}
  end
  else
  begin
    if (n > MaxEntries) and not
      (NewCtype in [Combinations, CombinationsDown, CombinationsCoLex,
      CombinationsCoLexDown]) then
    begin
      n := MaxEntries
    end
  end;
  r := NewR;
  if r < 1 then
  begin
    r := 0 {1}
  end
  else
  begin
    if ( not (NewCType in [CombinationsRepeat, CombinationsWithrep,CombinationsRepeatDown,
      PermutationsRepeat, PermutationsWithRep, PermutationsRepeatDown]) and
      (r > n)) then
    begin
      r := n
    end
  end;
  Ctype := newCtype;
  ClearArrays;
  case Ctype of
    Combinations: SetupNextLexRCombo;  {Lexicographical order up}
    Permutations: SetupNextLexRPermute; {Lexicographical order up}
    CombinationsDown: SetupPrevLexRCombo; {Lexicographical order down}
    PermutationsDown: SetupPrevLexRPermute; {Lexicographical order down}
    CombinationsCoLex: SetupNextCoLexRCombo; {Co-Lexicographical order up}
    CombinationsCoLexDown: SetupPrevCoLexRCombo; {Co-Lexicographical order down}
    PermutationsRepeat, PermutationsWithRep: SetupNextLexRepRPermute; {Lexicographical order up}
    PermutationsRepeatDown: SetupPrevLexRepRPermute; {Lexicographical order down}
    CombinationsRepeat,CombinationsWithrep: SetupNextLexRepRCombo; {Lexicographical order up}
    CombinationsRepeatDown: SetupPrevLexRepRCombo; {Lexicographical order down}
    else
    begin
      SetupNextLexRCombo
    end;                  {picked a default value to prevent warning}
  end;
  NumberOfSubsets := GetNumberSubsets(r,n,Ctype);
  if Ctype in [CombinationsDown, PermutationsDown, CombinationsCoLexDown,
    PermutationsRepeatDown,CombinationsRepeatDown] then
    Count := NumberofSubsets + 1
  else
    Count := 0;
end;

procedure TComboSet.SetupRFirstLast(NewR, NewN: word; NewCtype: TComboType);
begin
  n := NewN;
  if n < 1 then
  begin
    n := 1
  end
  else
  begin
    if n > MaxEntries then
    begin
      n := MaxEntries
    end
  end;
  r := NewR;
  if r < 1 then
  begin
    r := 1
  end
  else
  begin
    if ( not (NewCType in [PermutationsRepeat, PermutationsWithRep,PermutationsRepeatDown,