Search code examples
delphimathnumbersfiremonkeydelphi-xe8

Number Partition Algorithm Generator in Delphi XE8

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:

enter image description here

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.

Solution

  • 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