Разложение числа на слагаймые

[XemyL]

На входе у нас число (нат, пол) которое нужно разложить и ожидаймое количество слагаймых
алгоритм решения таков..выделяем место для одномерного массива, заполняем его 1-ми
увеличиваем последний елемент, пока сумма всех елементов не достигнет значения числа, которое мы разлогаем..выводим, уменшаем последний елемент на 1, при етом увеличивае предпоследний на 1 и т.д., но что бы выполнялись условия - следующий елемент (слагаймое) был не менше предущего и не больше остатка от разницы между суммой и предущим елементом. вывод тогда, когда остаток равный 0.
Нужно сделать программу БЕЗ рекурсии, но что то не доходит до меня как правильно наложить условия, в данном виде прога определяет только два слагаймые, при большем количестве идет зацыкливантие, помогите плс)

program RSlag;
uses crt;
var
   q: word;
   n: word;
   p, i: word;
   arr: array[1..1000] of word;

function Summ: boolean;
var
   i, sum: word;
begin
   sum := 0;
   for i := 1 to q do
   begin
      sum := sum + arr[i];
   end;
   if sum = n then Summ := true
   else Summ := false;
end;

procedure Printf;
var
   i: word;
begin
   for i := 1 to q do
      write(arr[i], ' ');
   writeln;
   readln;
end;

begin
   writeln('n: ');
   readln(n);
   writeln('q: ');
   readln(q);
   for i := 1 to q do
      arr[i] := 1;
   
   i:=1;
    if Summ <> true then
      repeat
         inc(arr[q])
      until Summ = true;
   printf;
   p := q;
   while Summ = true do
    begin
     if p <= i then 
      begin
      dec(p);
      inc(i);
      end;
     
      while (arr[p] >= arr[p - 1]) and (arr[p] <= (n - arr[p - 1])) do
       begin
        Printf;
        dec(arr[p]);
        inc(arr[p - i]);  
       end;
      if (arr[p] = arr[p - 1]) and (arr[p] = (n - arr[p - 1])) then
       begin
       dec(p);
       inc(i);
       end;

    end;
 
end.

з.ы. алгоритм такой, так как те же числа но в другой комбинации не должны выводится. пару дней уже думаю, но что то не идет...
начал писать на паскале, но и сишное решение если есть, подойдет

[Step_UA]

Немного подправил ваш алгоритм, буду базироваться на объявленных вами переменных:
- все слагаемые равны 1, arr[q] = n-q+1 - это у вас более менее делалось
- p=q - номер уменьшаемого слагаемого
1. Пока выполняется условие arr[p]-1>=arr[p-1]+1. значение arr[p] уменьшаем на 1, а предшествующее слагаемое arr[p-1] увеличиваем. Это значит, что arr[p-1] в конечном итоге не станет больше чем половина начального значения arr[p] - чтобы не повторялись слагаемые в другой комбинации
2. уменьшаем p на 1
3. если p>1 переходим на п.1

Привожу основное тело программы, в функции Summ нет необходимости:

begin
   write('n: ');   readln(n);
   write('q: ');   readln(q);
   for i := 1 to q-1 do arr[i]:= 1;
   arr[q]:=n-q+1;
   p := q;
   printf;
   repeat
     if (arr[p]-1)>=(arr[p-1]+1) then
       begin
        dec(arr[p]);
        inc(arr[p - 1]);
        printf;
       end
      else
        dec(p);
   until p=1;
end.

Добавьте проверку, чтоб количество слагаемых не превышало само число

[TinMan]

Сообщение от Step_UA

Немного подправил ваш алгоритм,

Боюсь, недостаточно..
Вот пример работы программы:

n: 10
q: 4
1 1 1 7
1 1 2 6
1 1 3 5
1 1 4 4
1 2 3 4

Тут явно не хватает некоторых вариантов:
1 2 2 5
1 3 3 3
...

Честно говоря, я вот так с первого взгляда не скажу, как тут делать без рекурсии (и без повторов). Без наворотов не обойтись..

[XemyL]

в том и дело, что с рекурсией я сделал,нужно две версии, а ета не идет никак

[Step_UA]

Согласен, поспешил ... 1 2 3 5 = 11

[TinMan]

Сообщение от Step_UA

1 2 3 5 = 11

))) блин, с этими компьютерами совершенно считать разучился.. ))
+1

[Step_UA]

Довольно интересная задачка, только изначально пошел не по тому пути ... если еще нужно:

uses crt;
var
   q: word;
   n: word;
   p, i: word;
   arr: array[1..1000] of word;
   num:word;

function max(k:word):integer;
{находит максимальное значение для слагаемого, стоящего на k-й позиции}
 var i,s:integer;
 begin
  s:=n;
  for i:=1 to k-1 do s:=s-arr[i];
  max:=s div (p-k+1)
 end;

begin
   write('n: ');   readln(n);
   write('q: ');   readln(q);
   num:=1;
   arr[1] := 0;
   p := q;
   repeat
    {если для слагаемого num достигнуто максимальное значение -
                                         смотрим предыдущее}
    while (num>0) and (arr[num]=max(num)) do dec(num);
    if num>0 then
     begin
      inc(arr[num]);     {увеличиваем слагаемое на 1 }
      for i:=num+1 to p-1 do arr[i]:=arr[i-1]; {все последующие, кроме
      последнего равны текущему слагаемому }
      arr[p]:=max(p);  { вычисляем значение последнего слагаемого }
      num:=p-1;
      for i := 1 to q do  { выводим слагаемые на экран }
         write(arr[i], ' ');
      readln;
     end;
   until num=0;
end.

[XemyL]

Спасибо, работает