ucombov2.pas

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

           CombinationsRepeat,CombinationsWithrep,CombinationsRepeatDown]) and
      (r > n)) then
    begin
      r := n
    end
  end;
  Ctype := newCtype;
  ClearArrays;
  case Ctype of
    Combinations: SetupFirstLexRCombo; {Lexicographical order up}
    Permutations: SetupFirstLexRPermute; {Lexicographical order up}
    CombinationsDown: SetupLastLexRCombo; {Lexicographical order down}
    PermutationsDown: SetupLastLexRPermute; {Lexicographical order down}
    CombinationsCoLex: SetupFirstCoLexRCombo; {Co-Lexicographical order up}
    CombinationsCoLexDown: SetupLastCoLexRCombo; {Co-Lexicographical order down}
    CombinationsRepeat,CombinationsWithrep: SetupFirstLexRepRCombo; {Lexicographical order up}
    CombinationsRepeatDown: SetupLastLexRepRCombo; {Lexicographical order down}
    PermutationsRepeat,PermutationsWithRep: SetupFirstLexRepRPermute; {Lexicographical order up}
    PermutationsRepeatDown: SetupLastLexRepRPermute; {Lexicographical order down}
    else
    begin
      SetupFirstLexRCombo
    end;                  {picked a default value to prevent warning}
  end;
  NumberofSubsets := GetNumberSubsets(r,n,Ctype);
  if Ctype in [CombinationsDown, PermutationsDown, CombinationsCoLexDown,
    CombinationsRepeatDown,PermutationsRepeatDown] then
    Count := NumberofSubsets
  else
    Count := 1;
end;

{******************** UnRank Functions ********************}
function TComboSet.UnRankR(const Rank: int64):boolean;
begin
  case {New}Ctype of
    Combinations, Combinationsdown: result:=UnRankLexRCombo(Rank);
    Permutations,
    PermutationsDown:
      Result := UnRankLexRPermute( Rank);
    CombinationsCoLex,
    CombinationsCoLexDown:
      Result := UnRankCoLexRCombo(Rank);
    PermutationsRepeat, PermutationsWithRep,
    PermutationsRepeatDown:
      Result := UnRankLexRepRPermute( Rank);
    CombinationsRepeat, CombinationsWithrep,
    CombinationsRepeatDown:
      Result := UnRankLexRepRCombo(Rank);
  else
    begin
      Result := False;
    end;
  end;

end;

function TComboSet.UnRankCoLexRCombo(const Rank: int64):boolean;
{
Based upon Algorthim 2:10, Donald Kresher and Douglas Simpson,
Combinatorial Algorthims, and fortran implementation KSUBSET_COLEX_UNRANK
by John Burkardt
}

var
  i, x: integer;
  k,  RankZeroBased:int64;
  wrank: int64;
begin
  x := n;
  result:=false;
  if not (Ctype in [CombinationsCoLex, CombinationsCoLexDown]) then exit;
  Result := IsValidRNRank(R,N,Rank,Ctype);
  If ctype=CombinationscoLexdown then wrank:=getcount+1-rank
  else wrank:=rank;
  RankZeroBased := wRank - 1;
  FillChar(Selected, SizeOf(Selected), 0);
  if not Result then
    exit;
  for i := 1 to R do
  begin
    k := R + 1 - i;
    while Binomial(k, x) > RankZeroBased do
    begin
      Dec(x)
    end;
    Selected[k]   := x + 1;
    RankZeroBased := RankZeroBased - Binomial(k, x);
  end;
end;

function TComboSet.UnRankLexRCombo(const Rank: int64):boolean;
var
  i:    integer;
  k, j: int64;
  wrank:int64;
begin
  k := 0;
  result:=false;
  if not (Ctype in [Combinations, CombinationsDown]) then exit;
  Result := IsValidRNRank(R,N,Rank,Ctype);
  FillChar(Selected, SizeOf(Selected), 0);
  if not Result then
    exit;
  If ctype= Combinations then wrank:=rank else wrank:=getcount-rank;
  for i := 1 to R - 1 do
  begin
    Selected[i] := Selected[i - 1];    {set to previous }
    j := 0;
    repeat
      Inc(k, j);                        {add previous binomial value if any}
      Inc(Selected[i]);                 {increase value}
      j := Binomial(R - i, N - Selected[i]);
    until (wRank <= (k + j));             {check rank with new binomial value}
  end;
  Selected[R] := Selected[R - 1] + wrank - k;   {set remaining value to diff}
end;

function TComboSet.UnRankLexRepRCombo({const RPick, Number: integer;} const Rank: int64):boolean;
var
  DistinctNo,i,RankRemaining : integer;
  wrank:int64;
begin
  result:=false;
  if not (Ctype in [CombinationsRepeat,CombinationsWithrep, CombinationsRepeatDown]) then exit;
  Result := IsValidRNRank(R,N,Rank,Ctype);
  FillChar(Selected, SizeOf(Selected), 0);
  if not Result then  exit;
  if ctype=combinationsrepeatdown then wrank:=getcount+1 - rank else wrank:=rank;
  DistinctNo := N;
  Selected[0] := 1;
  RankRemaining := wRank;
  for i := 1 to R - 1 do
  begin
    Selected[i] := Selected[i - 1];    {set to previous }
    While GetRepRCombo(R-i,DistinctNo) < RankRemaining do
    begin
      RankRemaining := RankRemaining - GetRepRCombo(R-i,DistinctNo);
      inc(Selected[i]);
      dec(DistinctNo);
    end;
  end;
  Selected[R] := Selected[R - 1] + RankRemaining - 1;   {set remaining value to diff}
end;

function TComboSet.UnRankLexRPermute(const Rank: int64):boolean;
var
  i, jj, UnusedCount, ZeroBasedNum: integer;
  k, RankZeroBased: int64;
  wrank:int64;
begin
  result:=false;
  if not (Ctype in [Permutations, PermutationsDown]) then exit;
  if ctype=permutationsdown then wrank:=getcount-rank + 1 else wrank:=rank;
  Result := IsValidRNRank(R,N,Rank,Ctype);
  if not Result then
    exit;
  RankZeroBased := wRank - 1;
  ClearArrays;
  k := GetRPermute(R, N) div N;
  for i := 1 to R - 1 do
  begin
    ZeroBasedNum := RankZeroBased div k;              {find quotient}
    RankZeroBased := RankZeroBased - ZeroBasedNum * k;  {calculate new dividend}
    {find ZeroBasedNum in Loops and set selected}
    UnusedCount := -1;
    jj := 0;
    repeat
      Inc(jj);
      while Loops[jj] = 1 do  {if marked as used then skip}
      begin
        Inc(jj)
      end;
      Inc(UnusedCount);
    until (UnusedCount = ZeroBasedNum);
    Loops[jj] := 1;          {mark as used}
    Selected[i] := jj;       {update value}
    k := k div (N - i); {calculate new divisor}
  end; {for loop}
  {RankZeroBased holds final unconverted value}
  UnusedCount := -1;
  jj := 0;
  repeat
    Inc(jj);
    while Loops[jj] = 1 do  {if marked as used then skip}
    begin
      Inc(jj)
    end;
    Inc(UnusedCount);
  until (UnusedCount = RankZeroBased);  {find value in sequence}
  Loops[jj] := 1;        {mark as used}
  Selected[R] := jj;       {update value}
end;

function TComboSet.UnRankLexRepRPermute(const Rank: int64):boolean;
var
  i: integer;
  k, RankZeroBased: int64;
  wrank:int64;
begin
  result:=false;
  if not (Ctype in [PermutationsRepeat,PermutationsWithrep, PermutationsRepeatDown]) then exit;
  Result := IsValidRNRank(R,N,Rank,Ctype);
  if not Result then
    exit;
  if ctype=PermutationsRepeatDown then wrank:=getcount-rank else wrank:=rank;
  RankZeroBased := wRank - 1;
  ClearArrays;
  k := GetRepRPermute(R - 1, N);
  for i := 1 to R - 1 do
  begin
    Selected[i]   := RankZeroBased div k;                   {find quotient}
    RankZeroBased := RankZeroBased - Selected[i] * k;       {calculate new dividend}
    Inc(Selected[i]);
    {convert quotient to position}
    k := k div (N);                                    {calculate new divisor}
  end;
  Selected[R] := RankZeroBased + 1;
end;

{******************** Direction Function ********************}
function TComboSet.ChangeRDirection: boolean;
var
  Ccount: int64;
begin
  Result := True;
  Ccount := Count - 1;
  case Ctype of
    Combinations:
    begin
      Ctype := CombinationsDown;
      Count := GetRCombo(r, n) - ccount;
    end;
    Permutations:
    begin
      Ctype := PermutationsDown;
      Count := GetRPermute(r, n) - ccount;
    end;
    CombinationsDown:
    begin
      Ctype := Combinations;
      Count := GetRCombo(r, n) - ccount;
    end;
    PermutationsDown:
    begin
      Ctype := Permutations;
      Count := GetRPermute(r, n) - ccount;
    end;
    CombinationsCoLex:
    begin
      Ctype := CombinationsCoLexDown;
      Count := GetRCombo(r, n) - ccount;
    end;
    CombinationsCoLexDown:
    begin
      Ctype := CombinationsCoLex;
      Count := GetRCombo(r, n) - ccount;
    end;
    PermutationsRepeat, PermutationsWithRep:
    begin
      Ctype := PermutationsRepeatDown;
      Count := GetRepRPermute(r, n) - ccount;
    end;
    PermutationsRepeatDown:
    begin
      Ctype := PermutationsRepeat;
      Count := GetRepRPermute(r, n) - ccount;
    end;
    CombinationsRepeat,CombinationsWithrep:
    begin
      Ctype := CombinationsRepeatDown;
      Count := GetRepRCombo(r, n) - ccount;
    end;
    CombinationsRepeatDown:
    begin
      Ctype := CombinationsRepeat;
      Count := GetRepRCombo(r, n) - ccount;
    end;
    else
    begin
      Result := False
    end;
  end;
  if not IsValidRSequence then
  begin
    SetupR(r, n, Ctype)
  end;
end;

function TComboSet.IsValidRSequence: boolean;
var
  i, k, temp,Counter: integer;
  UsedAry: ByteArray;
begin
  Result  := False;
  FillChar(UsedAry, SizeOf(UsedAry), 0);
  {Check range of sequence}
  for i := 1 to r do
  begin
    if (Selected[i] < 1) or (Selected[i] > n) then
    begin
      exit
    end
  end;
  {Check for repeated values in sequence e.g., permutations, permutationsdown}
  if not (Ctype in [PermutationsRepeat, PermutationsWithrep,PermutationsRepeatDown,
                    CombinationsRepeat,CombinationsWithrep, CombinationsRepeatDown]) then
  begin
    UsedAry := Selected;
    {sort values in array}
    for i := 1 to r-1 do
      for k := i+1 to r do
        if UsedAry[k] < UsedAry[i] then
        begin
          Temp := UsedAry[k];
          UsedAry[k] := UsedAry[i];
          UsedAry[i] := Temp;
        end;
    for i := 1 to r-1 do
      if UsedAry[i] = UsedAry[i+1] then
        exit
  end;
  if Ctype in [Permutations, PermutationsDown] then
  begin
    {Ensure each selected item is marked in internal loops array}
    Fillchar(loops,sizeof(loops),0);
    for i := 1 to r do
      loops[selected[i]] := 1;
(*  // old check took too long, just replace ...
    {check that each value in Selected is marked in Loops}
    for i := 1 to r do
    begin
      if Loops[Selected[i]] <> 1 then
      begin
        exit
      end
    end;
    {check that nothing else is marked in Loops}
    for i := 1 to n do
    begin
      if Loops[i] = 1 then
      begin
        Inc(Counter)
      end
    end;
    if Counter <> r then
    begin
      exit
    end;
*)
  end
  {check for increasing values in Selected}
  else
  begin
    if Ctype in [Combinations, CombinationsDown, CombinationsCoLex,
      CombinationsCoLexDown] then
    begin
      k := 0;
      for i := 1 to r do
      begin
        if Selected[i] <= k then
        begin
          exit
        end
        else
        begin
          k := Selected[i]
        end
      end
    end
    {check for equal or increasing values in Selected}
    else
    if Ctype in [CombinationsRepeat, CombinationsWithrep,CombinationsRepeatDown] then
    begin
      k := 1;
      for i := 1 to r do
      begin
        if (Selected[i] < k) or((i>1)and(selected[i-1]>selected[i])) then
        begin
          exit
        end
        else
        begin
          k := Selected[i]
        end
      end
    end
  end;
  {passed all tests}
  Result := True;
end;

{******************** Random Functions ********************}
function TComboSet.RandomR(const RPick, Number: integer;
  const NewCtype: TComboType): Boolean;
begin
  case NewCtype of
  Combinations,CombinationsDown:
    Result := RandomLexRCombo(RPick,Number);
  Permutations,PermutationsDown:
    Result := RandomLexRPermute(RPick,Number);
  CombinationsCoLex,CombinationsCoLexDown:
    Result := RandomCoLexRCombo(RPick,Number);
  PermutationsRepeat,  PermutationsWithrep,PermutationsRepeatDown:
    Result := RandomLexRepRPermute(RPick,Number);
  CombinationsRepeat,CombinationsWithrep,CombinationsRepeatDown:
    Result := RandomLexRepRCombo(RPick,Number);
  else
    Result := False;
  end;
end;

function TComboSet.RandomCoLexRCombo(const RPick, Number: integer):boolean;
var
RandomRank : int64;
begin
  RandomRank := random(GetRCombo(RPick,Number))+1; {Math.RandomRange(1,GetRCombo(RPick,Number));}
  Result := UnRankCoLexRCombo({RPick,Number,}RandomRank);
end;

function TComboSet.RandomLexRCombo(const RPick, Number: integer):boolean;
var
RandomRank : int64;
begin
  RandomRank := random(GetRCombo(RPick,Number))+1; {Math.RandomRange(1,GetRCombo(RPick,Number));}
  Result := UnRankLexRCombo(RandomRank);
end;

function TComboSet.RandomLexRepRCombo(const RPick, Number: integer):boolean;
var
RandomRank : int64;
begin
  RandomRank :=random(GetRepRCombo(RPick,Number))+1;  {GDD}
  Result := UnRankLexRepRCombo(RandomRank);
end;

function TComboSet.RandomLexRepRPermute(const RPick, Number: integer):boolean;
var
RandomRank : int64;
begin
   RandomRank := random(GetRepRPermute(RPick,Number))+1; {GDD}
  Result := UnRankLexRepRPermute(RandomRank);
end;

function TComboSet.RandomLexRPermute(const RPick, Number: integer):boolean;
var
RandomRank : int64;
begin
  RandomRank := random(GetRPermute(RPick,Number))+1; {GDD}
  Result := UnRankLexRPermute(RandomRank);
end;

initialization
  Combos := TComboset.Create;
  randomize;
end.