Форум «Всё о Паскале» _ Алгоритмы _ Разбиение числа на слагаемые
Автор: DarkWishmaster 17.04.2011 22:14
Надо методом перебора. Я сделал, только они повторяются: 1 3 5 - 5 3 1 Может у вас есть алгоритм для этой задачи? Я думал сохранить результаты в массиве, т.е если числа вектора не повторяются с теми что из массива то добавляем в массив, но это не эфективно, думаю есть более простой метод. Спасибо.
Автор: Lapp 18.04.2011 5:42
Цитата(DarkWishmaster @ 17.04.2011 23:14)
Надо методом перебора. Я сделал, только они повторяются: 1 3 5 - 5 3 1 Может у вас есть алгоритм для этой задачи? Я думал сохранить результаты в массиве, т.е если числа вектора не повторяются с теми что из массива то добавляем в массив, но это не эфективно, думаю есть более простой метод.
Есть. Подобные задачи решались на форуме много раз. Например, тут: http://forum.pascalnet.ru/index.php?showtopic=25114 (но не точно такая). А вообще - поиск..
Автор: volvo 18.04.2011 15:26
Цитата
Может у вас есть алгоритм для этой задачи?
Алгоритм ты озвучил сам: перебор.
Есть реализация: http://forum.pascalnet.ru/index.php?s=&showtopic=24291&view=findpost&p=133974 Повторений не наблюдается...
Автор: DarkWishmaster 18.04.2011 16:38
Забыл сказать что все числа должны быть разными (т.е варианты типа 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.
без рекурсии я знаю как сделать, а тут...
Автор: volvo 18.04.2011 16:48
Цитата
без рекурсии я знаю как сделать
Покажи то, что ты придумал без рекурсии...
Автор: DarkWishmaster 18.04.2011 17:20
Цитата(volvo @ 18.04.2011 16:48)
Покажи то, что ты придумал без рекурсии...
щяс попробую
Автор: volvo 18.04.2011 17:25
Заодно попробуй вот это (набирал прямо здесь, так что может чего где забыл, поправь если что) :
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 18.04.2011 17:46
Спасибо, 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.
твоя работает, иду разбираться, спасибо!
Автор: Lapp 19.04.2011 4:11
Цитата(volvo @ 18.04.2011 16:26)
Алгоритм ты озвучил сам: перебор.
Есть реализация: http://forum.pascalnet.ru/index.php?s=&showtopic=24291&view=findpost&p=133974 Повторений не наблюдается...
volvo, а почему ты счел возможным совершенно проигнорировать мой пост (http://forum.pascalnet.ru/index.php?s=&showtopic=28233&view=findpost&p=154771) и даже не извиниться?.. Мне кажется, это не принято.
По данной мной ссылке содержится решение, которое требует минимальных изменений (сделать вывод только в случае нужного числа слагаемых).
-1
Добавлено через 7 мин.
Цитата(volvo @ 18.04.2011 16:26)
Алгоритм ты озвучил сам: перебор.
Перебор - это класс алгоритмов, а не алгоритм.
Вот мое модифицированное решение:
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;
а почему ты счел возможным совершенно проигнорировать мой пост
Я не игнорировал пост. Зашел, посмотрел. Кстати, на мысль воспользоваться поиском меня навел именно твой пост. Но извиняться перед всей Вселенной за то, что может быть кто-то где-то когда-то уже писал подобную программу, или программу, которую можно минимальными усилиями преобразовать к нужному функционалу - не собираюсь.
Цитата
-1
Запомни этот пост. И потом, если вдруг у тебя начнут появляться минусы, я буду давать тебе на него ссылку. Если, конечно, ты не воспользуешься раньше возможностью чистки своего рейтинга, что уже было. Хочешь - напомню, где? Я, как видишь, этим не пользуюсь.
И, на будущее: я не влазил ни в одно твое обсуждение (по крайней мере, не приводил там СВОЙ код, максимум - давал наводящие замечания). Ты - залез везде, где только можно. Везде, где бы я не ответил - ты потом ТОЖЕ ПОБЫВАЛ, и оставил свою версию программы. Ну что ж...
Автор: Lapp 19.04.2011 11:50
Цитата(volvo @ 19.04.2011 11:46)
Я не игнорировал пост. Зашел, посмотрел. Кстати, на мысль воспользоваться поиском меня навел именно твой пост. Но извиняться перед всей Вселенной за то, что может быть кто-то где-то когда-то уже писал подобную программу, или программу, которую можно минимальными усилиями преобразовать к нужному функционалу - не собираюсь.
Запомни этот пост. И потом, если вдруг у тебя начнут появляться минусы, я буду давать тебе на него ссылку. Если, конечно, ты не воспользуешься раньше возможностью чистки своего рейтинга, что уже было. Хочешь - напомню, где? Я, как видишь, этим не пользуюсь.
И, на будущее: я не влазил ни в одно твое обсуждение (по крайней мере, не приводил там СВОЙ код, максимум - давал наводящие замечания). Ты - залез везде, где только можно. Везде, где бы я не ответил - ты потом ТОЖЕ ПОБЫВАЛ, и оставил свою версию программы. Ну что ж...
Очень впечатляет. а. достаточно было сказать в начале того поста "я тоже добавлю" хам ты, Володя хамом был, хамом остался и с хамами мне не по дороге
всего самого доброго, не буду больше следить в твоих темах, как и в остальных господствуй один