program IntegerPartitions;
{
Generate all ways to write a positive integer n
as a sum of positive integers (integer partitions).
}
type
TIntArray = array of Integer;
TArrayOfIntArray = array of TIntArray;
var
results: TArrayOfIntArray;
procedure AddResult(arr: TIntArray);
var
i, len: Integer;
begin
len := Length(results);
SetLength(results, len + 1);
SetLength(results[len], Length(arr));
for i := 0 to High(arr) do
results[len][i] := arr[i];
end;
procedure Backtrack(remaining, maxValue: Integer; current: TIntArray);
var
next, len: Integer;
newArr: TIntArray;
begin
if remaining = 0 then
begin
AddResult(current);
Exit;
end;
for next := maxValue downto 1 do
begin
if next <= remaining then
begin
len := Length(current);
SetLength(newArr, len + 1);
if len > 0 then
Move(current[0], newArr[0], len * SizeOf(Integer));
newArr[len] := next;
Backtrack(remaining - next, next, newArr);
end;
end;
end;
function Partitions(n: Integer): TArrayOfIntArray;
var
empty: TIntArray;
begin
SetLength(results, 0);
SetLength(empty, 0);
Backtrack(n, n, empty);
Partitions := results;
end;
var
output: TArrayOfIntArray;
i, j: Integer;
begin
output := Partitions(5);
WriteLn('[');
for i := 0 to High(output) do
begin
Write(' [ ');
for j := 0 to High(output[i]) do
begin
Write(output[i][j]);
if j < High(output[i]) then
Write(', ');
end;
Write(' ]');
if i < High(output) then
WriteLn(',')
else
WriteLn;
end;
WriteLn(']');
end.
(*
run:
[
[ 5 ],
[ 4, 1 ],
[ 3, 2 ],
[ 3, 1, 1 ],
[ 2, 2, 1 ],
[ 2, 1, 1, 1 ],
[ 1, 1, 1, 1, 1 ]
]
*)