Delphi XE8中的數字分區算法生成器

Question

如何在Delphi XE8中使高效，最簡單的算法輸出N 分區列表？

例如N=4 ，結果（假設在TListBox列出）：

4
3 + 1
2 + 2
2 + 1 + 1
1 + 1 + 1 + 1 

我嘗試了一些事情，決定使用動態數組：

var
  IntegerArray: array of Integer;

數一二三

然后在TListBox鍵入動態數組：

procedure TMForm.AddItem;
var
  Temp: String;
  I: Integer;
  II: Integer;

begin

  Temp:= '';
  for II:= 0 to Length(IntegerArray)-1 do
  begin

    for I := 0 to (IntegerArray[(Length(IntegerArray)-II)-1]-1) do
    begin
      Temp:= Temp+IntToStr(Length(IntegerArray)-II-1);
      Temp:= Temp+'+';
    end;
  end;

  delete(Temp,length(Temp),1);
  ListBox1.Items.Add(Temp);
end;

並開始編寫算法（到目前為止有效，但僅使用數字1,2和3來寫入分區），但看來我需要重寫以使用遞歸（因此它將使用所有可用數字來寫入分區），這就是我題; 在這里如何使用遞歸？

function TMForm.Calculate(MyInt: Integer): Integer;
var
  I: Integer;

begin
  ListBox1.Clear;
  GlobalInt:= MyInt;
  Result:= 0;

  SetLength(IntegerArray, 0);
  SetLength(IntegerArray, (MyInt+1));
  IntegerArray[1]:= MyInt;
  AddItem;
  Result:= Result+1;
  //
  if MyInt>1 then
  begin

    repeat  
      IntegerArray[1]:= IntegerArray[1]-2;
      IntegerArray[2]:= IntegerArray[2]+1;
      AddItem;
      Result:= Result+1;

    until ((IntegerArray[1]/2) < 1 );

    if MyInt>2 then
    repeat
      IntegerArray[3]:= IntegerArray[3]+1;
      IntegerArray[1]:= MyInt-IntegerArray[3]*3;
      IntegerArray[2]:= 0;
      AddItem;
      Result:= Result+1;

      if NOT ((IntegerArray[1]/2) < 1) then
      repeat
        IntegerArray[1]:= IntegerArray[1]-2;
        IntegerArray[2]:= IntegerArray[2]+1;
        AddItem;
        Result:= Result+1;
      until ((IntegerArray[1]/2) <=1 );

      IntegerArray[1]:= MyInt-IntegerArray[3]*3;
      IntegerArray[2]:= 0;
    until ((IntegerArray[1]/3) < 1 );

    //if MyInt>3 then...


  end;

  Edit1.Text:= IntToStr(Result);
end;

---

運行當前程序的示例：

更新

設法使它像這樣工作：

procedure TMForm.Calculate(MyInt: Integer);
var
  I: Integer;

begin
  ListBox1.Clear;
  GlobalInt:= MyInt;
  ItemCount:= 0;

  SetLength(IntegerArray, 0);
  SetLength(IntegerArray, (MyInt+1));
  IntegerArray[1]:= MyInt;
  AddItem;
  ItemCount:= ItemCount+1;
  //
  if MyInt>1 then
  Step2;

  if MyInt>2 then
  for I := 3 to MyInt do
  Steps(I);

  Edit1.Text:= IntToStr(ItemCount);
end;

procedure TMForm.Steps(n: Integer);
var
  I,II: Integer;

begin
  if not ((IntegerArray[1]/n) < 1 ) then
  repeat
    IntegerArray[n]:= IntegerArray[n]+1;
    //
    IntegerArray[1]:= GlobalInt;
    for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
    //
    AddItem;
    ItemCount:= ItemCount+1;
    Step2;

    if n>3 then
    for II := 3 to (n-1) do
    begin
      Steps(II);
    end;

  until ((IntegerArray[1]/n) < 1 );
  //
  IntegerArray[n]:= 0;
  IntegerArray[1]:= GlobalInt;
  for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;

procedure TMForm.SpinBox1Change(Sender: TObject);
begin
  SpinBox2.Value:= SpinBox1.Value;
end;

procedure TMForm.Step2;
var
  I: Integer;
begin
    if NOT ((IntegerArray[1]/2) < 1) then
    repeat
      IntegerArray[1]:= IntegerArray[1]-2;
      IntegerArray[2]:= IntegerArray[2]+1;
      AddItem;
      ItemCount:= ItemCount+1;

    until ((IntegerArray[1]/2) < 1 );

  IntegerArray[2]:= 0;
  IntegerArray[1]:= GlobalInt;
  for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;

procedure TMForm.FormCreate(Sender: TObject);
begin
  //
end;

但很明顯，我需要一些優化。

Answer 1

沒錯，最簡單的實現是遞歸的。

有一些優化的可能性（對於較大的值，最好存儲較小值的分區並一次又一次地使用它們），但是我認為對於較大的N個值，結果列表的大小對於輸出而言將太大。

//N is number for partitions, M is maximum part value 
//(used here to avoid permutation repeats like 3 1 and 1 3)
procedure Partitions(N, M: integer; s: string);
var
  i: integer;
begin
  if N = 0 then
    Memo1.Lines.Add(s)
  else
    for i := Min(M, N) downto 1 do
      Partitions(N - i, i, s + IntToStr(i) + ' ');
end;

begin
  Partitions(7, 7, '');

提供輸出

7 
6 1 
5 2 
5 1 1 
4 3 
4 2 1 
4 1 1 1 
3 3 1 
3 2 2 
3 2 1 1 
3 1 1 1 1 
2 2 2 1 
2 2 1 1 1 
2 1 1 1 1 1 
1 1 1 1 1 1 1 

Answer 2

您的鏈接引用了以下內容： 生成整數分區的快速算法 。

在此處實現建議的最快算法（ZS1和ZS2）看起來像這樣：（注意，這里沒有遞歸！）

procedure PartitionsZS1(n: Integer);
var
  x: TArray<Integer>;
  i,r,h,t,m: Integer;
begin
  SetLength(x,n+1);
  for i := 1 to n do x[i] := 1;
  x[1] := n;
  m := 1;
  h := 1;
  WriteLn(x[1]);
  while (x[1] <> 1) do begin
    if (x[h] = 2) then begin
      m := m + 1;
      x[h] := 1;
      h := h - 1;
    end
    else begin
      r := x[h] - 1;
      t := m - h + 1;
      x[h] := r;
      while (t >= r) do begin
        h := h + 1;
        x[h] := r;
        t := t - r;
      end;
      if (t = 0) then
        m := h
      else begin
        m := h + 1;
        if (t > 1) then begin
          h := h + 1;
          x[h] := t;
        end;
      end;
    end;
    for i := 1 to m do Write(x[i]);
    WriteLn;
  end;
end;

procedure PartitionsZS2(n: Integer);
var
  x: TArray<Integer>;
  i,j,r,h,m: Integer;
begin
  SetLength(x,n+1);
  for i := 1 to n do x[i] := 1;
  for i := 1 to n do Write(x[i]);
  WriteLn;
  x[0] := -1;
  x[1] := 2;
  h := 1;
  m := n - 1;
  for i := 1 to m do Write(x[i]);
  WriteLn;
  while (x[1] <> n) do begin
    if (m-h > 1) then begin
       h := h + 1;
       x[h] := 2;
       m := m - 1;
    end
    else begin
      j := m - 2;
      while (x[j] = x[m - 1]) do begin
        x[j] := 1;
        j := j - 1;
      end;
      h := j + 1;
      x[h] := x[m - 1] + 1;
      r := x[m] + x[m - 1]*(m-h-1);
      x[m] := 1;
      if (m - h) > 1 then
        x[m-1] := 1;
      m := h + r - 1;
    end;
    for i := 1 to m do Write(x[i]);
    WriteLn;
  end;
end;

---

program Project61;

{$APPTYPE CONSOLE}

begin
  PartitionsZS1(7);
  WriteLn;
  PartitionsZS2(7);
end.

輸出：

7
61
52
511
43
421
4111
331
322
3211
31111
2221
22111
211111
1111111

1111111
211111
22111
2221
31111
3211
322
331
4111
421
43
511
52
61
7