Перечислить все разбиения N на целые положительные слагаемые

Материал из DRKB


Пример:

N=4, разбиения: 1+1+1+1, 2+1+1, 2+2, 3+1, 4.
First = (1, 1, ..., 1) - N единиц Last = (N)

Чтобы разбиения не повторялись, договоримся перечислять слагаемые в невозрастающем порядке. Сказать, сколько их будет всего, не так-то просто (см.следующий пункт). Для составления алгоритма Next зададимся тем же вопросом: в каком случае i-ый член разбиения можно увеличить, не меняя предыдущих?

Во-первых, должно быть X[i-1] > X[i] или i=1. Во-вторых, i должно быть не последним эле ментом (увеличение i надо компенсировать уменьшением следующих). Если такого i нет, то данное разбиение последнее. Увеличив i, все следующие элементы надо взять минимально возможными, т.е. равными единице:

procedure Next;
begin
  { найти i: (i<L) and ( (X[i-1]>X[i]) or (i=1) ) }
  X[i] := X[i] + 1;
  { L:= i + X[i+1]+...+X[L] - 1 }
  X[i+1] := ... := X[L] := 1;
end;


Через L мы обозначили количество слагаемых в текущем разбиении (понятно, что 1 <= L <= N). Программа будет выглядеть так:

program Razbieniya;
type
  TRazb = array [Byte] of Byte;
var
  N, i, L: Byte;
  X: TRazb;

procedure Next(var X: TRazb; var L: Byte);
var
  i, j: Byte;
  s: Word;
begin
  i := L-1;
  s := X[L];
  { поиск i }
  while (i > 1) and (X[i-1] <= X[i]) do
  begin
    s := s+X[i];
    Dec(i);
  end;
  Inc(X[i]);
  L := i + s - 1;
  for j := i+1 to L do
    X[j] := 1;
end;

begin
  Write('N=');
  ReadLn(N);
  L := N;
  for i := 1 to L do
    X[i] := 1;
  for i := 1 to L do
    Write(X[i]);
  WriteLn;
  repeat
    Next(X, L);
    for i := 1 to L do
      Write(X[i]);
    WriteLn;
  until L = 1;
end.


Source: http://algolist.manual.ru
ID: 04181