How to find all possible ways to write a positive integer as a sum of positive integers in Pascal

2 Answers

0 votes
program Partitions;

{ Print a partition stored in 'arr' in the form "a + b + c" }
procedure PrintArray(arr: array of Integer; size: Integer);
var
    i: Integer;
begin
    for i := 0 to size - 1 do
    begin
        if i > 0 then
            Write(' + ');   { add plus signs between numbers }
        Write(arr[i]);
    end;
    WriteLn;
end;

{
    Generate all partitions of a number using non-decreasing sequences.

    arr       – current partial partition being built
    size      – how many elements are currently in arr
    start     – the smallest number allowed next (prevents duplicates like 2+1 vs 1+2)
    remaining – how much is left to reach the target sum

    When remaining == 0, arr contains a complete valid partition.
}
procedure Partitions(var arr: array of Integer; size, start, remaining: Integer);
var
    j: Integer;
begin
    { Base case: exact sum reached }
    if remaining = 0 then
    begin
        if size >= 2 then      { enforce "two or more integers" }
            PrintArray(arr, size);
        Exit;
    end;

    { Try all next values from 'start' up to 'remaining' }
    for j := start to remaining do
    begin
        arr[size] := j;                          { choose j }
        Partitions(arr, size + 1, j, remaining - j);  { recurse with reduced remainder }
        { no need to "pop" in Pascal; we just overwrite next time }
    end;
end;

var
    n: Integer;
    arr: array[0..128] of Integer;  { holds current partition (large enough buffer) }

begin
    n := 5;                 { number to partition }
    Partitions(arr, 0, 1, n);  { start with smallest allowed value = 1 }
end.



(*
run:

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

*)

 



answered 1 day ago by avibootz
0 votes
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 ]
]

*)

 



answered 9 hours ago by avibootz

Related questions

...