ucombov2.pas

Delphi的大数运算演示 pudn上大多是VC的 所以传个Delphi的

     ((RPick > Number) and (not(aCtype in [PermutationsRepeat,
     PermutationsWithrep, CombinationsWithRep,
     PermutationsRepeatDown, CombinationsRepeat,CombinationsWithrep,CombinationsRepeatDown]))) then
       exit;
  Result := True;
end;

function TComboSet.IsValidRNRank(const RPick,Number,Rank:integer;const ACtype:TComboType):boolean;

begin
   Result := False;
   if (rank < 1) or not IsValidRN(RPick,Number,ACtype) then exit;
   case ACType of
   Combinations,
   CombinationsDown,
   CombinationsCoLex,
   CombinationsCoLexDown:  if (Rank > Binomial(RPick, Number)) then exit;
   CombinationsRepeat, CombinationsWithRep,
   CombinationsRepeatDown: if (Rank > GetRepRCombo(RPick,Number)) then exit;
   Permutations,
   PermutationsDown: if (Rank > GetRPermute(RPick,Number)) then exit;
   PermutationsRepeat, PermutationsWithRep,
   PermutationsRepeatDown:  if (Rank > GetRepRPermute(RPick,Number)) then exit;
   else
     exit;
   end;
   Result := True;
end;

 {******************** PUBLIC FUNCTIONS ********************}
 {******************** Misc Calculator Functions ********************}
function TComboSet.GetNumberSubsets(const RPick, Number : word; const ACtype : TComboType):int64;

begin
  case ACtype of
    Combinations,
    CombinationsDown,
    CombinationsCoLex,
    CombinationsCoLexDown  : Result := GetRCombo(RPick,Number);
    Permutations,
    PermutationsDown       : Result := GetRPermute(RPick,Number);
    PermutationsRepeat, PermutationsWithrep,
    PermutationsRepeatDown : Result := GetRepRPermute(RPick, Number);
    CombinationsRepeat, CombinationsWithRep,
    CombinationsRepeatDown : Result := GetRepRCombo(RPick, Number);
  else
    Result := 0;
  end;
end;


function TComboSet.Binomial(const RPick, Number: integer): int64;
begin
  Result := 0;
  if (Number > 0) and (Number >= RPick) then
    Result := GetRCombo(RPick, Number)
end;

function TComboSet.Factorial(const Number: integer): int64;
begin
  case Number of  {int64 can only hold 20! so precalculated to save time}
    2: Result := 2;
    3: Result := 6;
    4: Result := 24;
    5: Result := 120;
    6: Result := 720;
    7: Result := 5040;
    8: Result := 40320;
    9: Result := 362880;
    10: Result := 3628800;
    11: Result := 39916800;
    12: Result := 479001600;
    13: Result := 6227020800;
    14: Result := 87178291200;
    15: Result := 1307674368000;
    16: Result := 20922789888000;
    17: Result := 355687428096000;
    18: Result := 6402373705728000;
    19: Result := 121645100408832000;
    20: Result := 2432902008176640000;
    else
    begin
      Result := 1;
    end;
  end;
end;

function TComboSet.GetRCombo(const RPick, Number: integer): int64;
{This function is based on:
 ACM algorithm 160,Communications of the ACM, April, 1963.
}

var
  i, f, nn, rr: integer;
  num: extended;
begin
  Result := 1;  {this function defaults to 1 use binomial}
  nn     := Number;
  rr     := RPick;
  num    := 1;
  if (nn <= rr) then
  begin
    exit
  end;
  if (rr * 2 > nn) then
  begin
    rr := nn - rr
  end;
  for i := 1 to rr do
  begin
    f := nn;
    if (nn mod i = 0) then
    begin
      f := f div i
    end
    else
    begin
      num := num / i
    end;
    num := num * f;
    Dec(nn);
  end;
  Result := trunc(num + 0.5);
end;

function TComboSet.GetRepRCombo(const RPick, Number: integer): int64;
{Example how many different ways can you get a dozen of donuts assuming
30 different varieties ... GetRepRCombo(30,12)}
begin
  Result := GetRCombo(RPick, Number + RPick - 1);
end;

function TComboSet.GetRPermute(const RPick, Number: integer): int64;
begin
  { Permutation(n,r) = n! / (n-r)!
    Combination(n,r) = n! / ( (n-r)! * r! )
    Permutation(n,r) = Combination(n,r) * r!
    Permutation(n,r) = n! / ( (n-r)! * r! ) * r!}
  Result := GetRCombo(RPick, Number) * Factorial(RPick);
end;

function TComboSet.GetRepRPermute(const RPick, Number: integer): int64;
var
  Val: extended;
begin
  Val := ln(Number + 0.0) * RPick;
  if (Val > 62.999999999) or (Val < ln(1)) then      {ensure value not too large}
    Result := 1
  else
    Result := trunc(exp(Val) + 0.5);
end;

 {******************** Next Functions ********************}
 {Functions to increment to next position (if any) and return boolean result}
function TComboSet.NextR: boolean;
begin {NextR}
  case Ctype of
    Combinations:
    begin
      Result := NextLexRCombo;    {Lexicographical order up}
      Inc(Count);
    end;
    Permutations:
    begin
      Result := NextLexRPermute;  {Lexicographical order up}
      Inc(Count);
    end;
    CombinationsCoLex:
    begin
      Result := NextCoLexRCombo;  {Co-Lexicographical order up}
      Inc(Count);
    end;
    CombinationsRepeat,CombinationsWithrep:
    begin
      Result := NextLexRepRCombo;
      inc(count);
    end;
    PermutationsRepeat, PermutationsWithRep:
    begin
      Result := NextLexRepRPermute;{Lexicographical order up}
      Inc(Count);
    end;
    else
    begin
      Result := False
    end;                                   {Error}
  end;
end;


function TComboSet.NextCoLexRCombo: boolean;
var
  i: integer;
begin
  if Selected[1] > (n - r) then  {check to see if final sequence}
  begin
    Result := False;
    exit;
  end;
  Result := True;
  i      := 1;          {start with first position}
  while (Selected[i + 1] - Selected[i]) = 1 do  {check if current position at max value}
  begin
    Selected[i] := i;   {reset to lowest value}
    Inc(i);             {increase position}
  end;
  Inc(Selected[i]);     {increase}
end;

function TComboSet.NextLexRCombo: boolean;
var
  k, g: integer;
begin
  Result := True;                {Set Default Value}
  k      := r;                   {assign local variable for speed}
  if Selected[k] < n then        {if not max then increase and exit}
  begin
    Inc(Selected[k]);
    exit;
  end;
  if Selected[1] > n - r then     {check to see if last combination}
  begin
    Result := False;
    exit;
  end;
  while (Selected[k] - Selected[k - 1]) = 1 do  {walk down chain}
    Dec(k);
  Inc(Selected[k - 1]);           {increase item}
  g := Selected[k - 1];           {set temp variable for speed}
  while k <= r do               {set all remaining values to previous value+1}
  begin
    Inc(g);
    Selected[k] := g;
    Inc(k);
  end;
end;

function TComboSet.NextLexRepRCombo: boolean;
var
  k, g: integer;
begin
  Result := True;                {Set Default Value}
  k      := r;                   {assign local variable for speed}
  if Selected[k] < n then        {if not max then increase and exit}
  begin
    Inc(Selected[k]);
    exit;
  end;
  if Selected[1] >= n then     {check to see if last combination}
  begin
    Result := False;
    exit;
  end;
  while (Selected[k] = Selected[k - 1])  do  {walk down chain}
    Dec(k);
  Inc(Selected[k - 1]);           {increase item}
  g := Selected[k - 1];           {set temp variable for speed}
  while k <= r do               {set all remaining values to previous value+1}
  begin
    Selected[k] := g;
    Inc(k);
  end;
end;


function TComboSet.NextLexRepRPermute: boolean;
var
  i, k: integer;
begin
  Result := True;
  k      := r;
  if Selected[k] < n then      {try to increase last item in sequence}
  begin
    Inc(Selected[k]);
    exit;
  end;
  while (Selected[k] = Selected[k - 1]) do {walk down chain}
    Dec(k);
  if k = 1 then              {check for end of sequence}
  begin
    Result := False;
    exit;
  end;
  Inc(Selected[k - 1]);          {increase position by one}
  for i := k to r do             {reset all other itmes}
    Selected[i] := 1
end;

function TComboSet.NextLexRPermute: boolean;
var
  i, j, k, IncPos: integer;
label
  BreakDoLoop;

begin
  Result := True;                       {set default result value}
  IncPos := r;                          {start with right most position}
  while True do
  begin
    i := Selected[IncPos] + 1;
    if i <= n then
    begin                                {find next unselected value if any}
      while Loops[i] = 1 do                {loop unrolled by factor of 5}
      begin
        if Loops[i + 1] = 1 then
        begin
          if Loops[i + 2] = 1 then
          begin
            if Loops[i + 3] = 1 then
            begin
              if Loops[i + 4] = 1 then
              begin
                Inc(i, 5)
              end
              else
              begin
                Inc(i, 4);
                break;
              end
            end
            else
            begin
              Inc(i, 3);
              break;
            end
          end
          else
          begin
            Inc(i, 2);
            break;
          end
        end
        else
        begin
          Inc(i);
          break;
        end
      end;

      if i <= n then                      {if value found is valid}
      begin
        Loops[Selected[IncPos]] := 0;     {mark old value as unused}
        Loops[i] := 1;                    {mark new value as used}
        Selected[IncPos] := i;            {place new value in Selected array}
        goto BreakDoLoop;                 {found solution}
      end;
    end;                                  {end if Selected}

(*  {old code unrolled for speed}
   for i := Selected[incpos]+1 to n do
    if loops[i] <> 1 then              {found smallest greater value not previously used}
    begin
     loops[Selected[incpos]] := 0;     {mark old value as unused}
     loops[i] := 1;                    {mark new value as used}
     Selected[incpos] := i;            {place new value in Selected array}
     goto breakdoloop;                 {found solution}
    end;
*)

    if IncPos > 1 then
      {could not find greater value so backup 1 and look again}
    begin
      Loops[Selected[IncPos]] := 0;     {mark old value as unused}
      Dec(IncPos);                      {backup 1 space}
    end
    else
    begin
      Result := False;                  {reached end of permutation}
      exit;
    end;
  end;
  BreakDoLoop:

    if IncPos < r then
      {need to fill remaining values in lexicographical order}
    begin
      k := 1;
      for j := IncPos + 1 to r do       {for each remaining value}
      begin
        {          while loops[k] = 1 do inc(k);}
        {      unroll loop by a factor of 5 for speed}
        while True do              {find next lexicographical value}
        begin
          if Loops[k] = 1 then
          begin
            if Loops[k + 1] = 1 then
            begin
              if Loops[k + 2] = 1 then
              begin
                if Loops[k + 3] = 1 then
                begin
                  if Loops[k + 4] = 1 then
                  begin
                    Inc(k, 5)
                  end
                  else
                  begin
                    Inc(k, 4);
                    break;
                  end
                end
                else
                begin
                  Inc(k, 3);
                  break;
                end
              end
              else
              begin
                Inc(k, 2);
                break;
              end
            end
            else
            begin
              Inc(k, 1);
              break
            end
          end
          else
          begin
            break
          end;
        end;
        {unroll loop end}
        Selected[j] := k;          { update array for new value}
        Loops[k]    := 1;           {mark value as used}
        Inc(k);
      end;
    end;
end;

Function TComboset.GetNextComboWithRep:Boolean;
begin
  result:=NextLexRepRCombo;
end;

Function TComboset.GetNextPermuteWithRep:Boolean;
begin
  result:=NextLexRepRPermute;
end;

 {******************** Prev Functions ********************}
 {Functions to decrement to previous position (if any) and return boolean result}
function TComboSet.PrevR: boolean;
begin {PrevR}
  case Ctype of
    CombinationsDown:
    begin
      Result := PrevLexRCombo;    {Lexicographical order down}
      Dec(Count);
    end;
    PermutationsDown:
    begin
      Result := PrevLexRPermute;  {Lexicographical order down}
      Dec(Count);
    end;
    CombinationsCoLexDown:
    begin
      Result := PrevCoLexRCombo;  {Co-Lexicographical order down}