Number Partition Algorithm Generator in Delphi XE8 - delphi

Question

How to make efficient and simplest algorithm to output a list of number N Partitions in Delphi XE8?
For example N=4, the result (Lets say listed in a TListBox):
4
3 + 1
2 + 2
2 + 1 + 1
1 + 1 + 1 + 1
I have tried something, decided to use a dynamic array:
var
IntegerArray: array of Integer;
To count the ones, twos, threes,...
And this to type out the dynamic array in a 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;
And started writing the algorithm (so far works but uses only numbers 1,2 and 3 to write partitions), but it seems I need to rewrite it to use recursion (so it will use all available numbers to write partitions), and that's my question; how to use recursion here?
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;
Example of running the current program:
Update
Managed to make it work like this:
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;
But clearly, I need some optimization.

Answer 1

You are right, the simplest implementation is recursive.
There are some possibilities for optimization (for larger values it would be nice to store partitions of smaller values and use them again and again), but I think that for big N values the result list size will be too huge for output
//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, '');
gives output
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

From your link there was a reference to: Fast Algorithms for Generating Integer Partitions
.
Implementing the proposed fastest algorithms there (ZS1 and ZS2) looks like this:
(Note, there is no recursion here!)
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.
Outputs:
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