Разбиение числа на слагаемые, Надо разбить число N на суму из K слагаемых. Опции

[DarkWishmaster]

Надо методом перебора. Я сделал, только они повторяются:
1 3 5 - 5 3 1
Может у вас есть алгоритм для этой задачи?
Я думал сохранить результаты в массиве, т.е если числа вектора не повторяются с теми что из массива то добавляем в массив, но это не эфективно, думаю есть более простой метод.
Спасибо.

[Lapp]

Надо методом перебора. Я сделал, только они повторяются:
1 3 5 - 5 3 1
Может у вас есть алгоритм для этой задачи?
Я думал сохранить результаты в массиве, т.е если числа вектора не повторяются с теми что из массива то добавляем в массив, но это не эфективно, думаю есть более простой метод.

Есть.
Подобные задачи решались на форуме много раз. Например, тут: Рекурсия (но не точно такая). А вообще - поиск..

[volvo]

Может у вас есть алгоритм для этой задачи?

Алгоритм ты озвучил сам: перебор.

Есть реализация: числа, дающие в сумме заданное число
Повторений не наблюдается...

[DarkWishmaster]

Забыл сказать что все числа должны быть разными (т.е варианты типа 3 3 9 не печатать)
Вот моя идея:
например для n=9, k=3
создаем вектор: 1 2 3
Теперь увеличиваем 3 пока сума вектора не будет N
1 2 4
1 2 5
1 2 6 -> решение
теперь идем к переведущему числу, уже к 2 и увеличиваем его на 1 единицу:
и опять последний увеличиваем:
1 3 4
1 3 5 -> решение
увиличиваем 3
так как 1 4 5 больше N
то идем к первому элементу и увеличиваем его
2 3 4 ->решение
теперь уже ничего увеличивать нельзя, так как сума будет больше N
Вот что я пробовал сделать :

Program (Показать/Скрыть)

Uses Crt;
var  a:array[0..10] of integer; n,q,i:integer;
   function Suma:boolean;  //смотрим суму вектора, если равна N значит ответ TRUE
   var S,i:integer;
   begin
     S:=0;
     for i:=1 to q do
     S:=S+a[i];
     Suma:=(S=n);
   end;
   procedure Print; 
   var i:integer;
   begin
    for i:=1 to q do
     write(a[i],' ');
   { readln;}
   end;
  procedure BackTr(k:integer);
  var i:integer;
     begin
     if q=k-1 then  Print  //но тут ещё if Suma then Print надо поставить
      else  begin
       i:=a[k-1]+1; 
         while  not Suma do begin
         a[k]:=i;
         BackTr(k+1);
         inc(i);
       end;
      end;
    end;
 Begin ClrScr;
 readln(n,q);
 BackTr(1);
 readln;
 end. 

без рекурсии я знаю как сделать, а тут...

Сообщение отредактировано: DarkWishmaster - 18.04.2011 20:39

[volvo]

без рекурсии я знаю как сделать

Покажи то, что ты придумал без рекурсии...

[DarkWishmaster]

Покажи то, что ты придумал без рекурсии...

щяс попробую

[volvo]

Заодно попробуй вот это (набирал прямо здесь, так что может чего где забыл, поправь если что) :

var
  q : integer;
  n : integer;

  arr : array[1 .. 10] of integer;

procedure p(start, count : integer);
var i, s : integer;
begin
  if count > q then
  begin
    s := 0;
    for i := 1 to q do s := s + arr[i];
    if s = n then
    begin
      for i := 1 to q do write(arr[i]:3);
      writeln;
    end;
  end
  else
  begin
    for i := start + 1 to n do // Вот основная идея: чтоб решения и слагаемые не повторялись
    begin
      arr[count] := i;
      p(arr[count], count + 1); // рекурсия присутствует
    end;
  end;
end;

begin
  n := 9;
  q := 3;
  p(0, 1);
end.

[DarkWishmaster]

Спасибо, volvo, только что закончил, вот без рекурсии
только пока работает только с макс. с K=3

KOD (Показать/Скрыть)

Uses Crt;
var n,q,i:integer; a:array[1..3] of integer; flag:boolean;
  function Ok:boolean; //смотрим если можем продолжать добовлять
  var i,S:integer;
  begin
  S:=0;
     for i:=a[1] to q+a[1]-1 do
     S:=S+i;
     if S<n  then Ok:=True
     else ok:=False;
  end;
   function Suma:boolean; 
    var i,S:integer;
    begin
      S:=0;
      for i:=1 to q do
      S:=S+a[i];
     Suma:=(S>=N);
    end;
  procedure Print;
    var i:integer;
    begin
     for i:=1 to q do
      write(a[i],' ');
     writeln;
    end;
  begin     CLrSCr;
        readln(n,q);
        for i:=1 to q do
        a[i]:=i;  
             repeat
             flag:=false; //флаг ставим на 0
             while not Suma do begin
             a[i]:=a[i]+1;
             flag:=true;    // флаг 1
             end;
       if flag=false then dec(i) 
                                else Print;
        if Ok then
        begin
        if flag=false then begin
        dec(i);
        a[i]:=a[i]+1;
        repeat
            inc(i);
            a[i]:=a[i-1]+1;
         until i=q end
           else begin
           dec(i);
           a[i]:=a[i]+1;
           inc(i);
           a[i]:=a[i-1]+1;
          end;
         if  (OK=False) and (Suma) then Print;
         end;
      until OK=False;
Readln;
end.

твоя работает, иду разбираться, спасибо!

Сообщение отредактировано: DarkWishmaster - 18.04.2011 21:53

[Lapp]

Алгоритм ты озвучил сам: перебор.

Есть реализация: числа, дающие в сумме заданное число
Повторений не наблюдается...

volvo, а почему ты счел возможным совершенно проигнорировать мой пост (Разбиение числа на слагаемые) и даже не извиниться?.. Мне кажется, это не принято.

По данной мной ссылке содержится решение, которое требует минимальных изменений (сделать вывод только в случае нужного числа слагаемых).

-1

Добавлено через 7 мин.

Алгоритм ты озвучил сам: перебор.

Перебор - это класс алгоритмов, а не алгоритм.

Вот мое модифицированное решение:

const
  m=1000;
var
  a: array[1..m]of integer;
  k,n,q: integer;

procedure Split(j,n: integer);
var
  i: integer;
begin
  if (n=0)and(k=q) then begin
    for i:=1 to k do Write(a[i]:4);
    WriteLn
  end
  else for i:=j to n do begin
    Inc(k);
    a[k]:=i;
    Split(i+1,n-i);
    Dec(k)
  end
end;

begin
  Write('n = ');
  ReadLn(n);
  Write('q = ');
  ReadLn(q);
  k:=0;
  Split(1,n);
  ReadLn
end.

[volvo]

а почему ты счел возможным совершенно проигнорировать мой пост

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

-1

Запомни этот пост. И потом, если вдруг у тебя начнут появляться минусы, я буду давать тебе на него ссылку. Если, конечно, ты не воспользуешься раньше возможностью чистки своего рейтинга, что уже было. Хочешь - напомню, где? Я, как видишь, этим не пользуюсь.

И, на будущее: я не влазил ни в одно твое обсуждение (по крайней мере, не приводил там СВОЙ код, максимум - давал наводящие замечания). Ты - залез везде, где только можно. Везде, где бы я не ответил - ты потом ТОЖЕ ПОБЫВАЛ, и оставил свою версию программы. Ну что ж...

[Lapp]

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

Запомни этот пост. И потом, если вдруг у тебя начнут появляться минусы, я буду давать тебе на него ссылку. Если, конечно, ты не воспользуешься раньше возможностью чистки своего рейтинга, что уже было. Хочешь - напомню, где? Я, как видишь, этим не пользуюсь.

И, на будущее: я не влазил ни в одно твое обсуждение (по крайней мере, не приводил там СВОЙ код, максимум - давал наводящие замечания). Ты - залез везде, где только можно. Везде, где бы я не ответил - ты потом ТОЖЕ ПОБЫВАЛ, и оставил свою версию программы. Ну что ж...

Очень впечатляет.
а. достаточно было сказать в начале того поста "я тоже добавлю"
хам ты, Володя
хамом был, хамом остался
и с хамами мне не по дороге

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

[Lapp]

Тема разделена, остаток перенесен сюда: О недавних событиях на Форуме

[ta bort gäddhä]

My family all the time say that I am killing my time here at net, but I know I am getting familiarity daily by reading such good articles or reviews. ta bort gäddhäng med laser juakee.sewomabest.com/map21.php