Форум: "Потрепаться";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];
Вниз
Задача для разминки мозгов Найти похожие ветки
← →
Сатир (2002-12-25 14:49) [0]есть ряд натуральных чисел от 1 до N
есть число K
Определить число комбинаций членов ряда, которые в сумме дадут K.
Рассмотреть все варианты.
Даю неделю на решение после чего будет оглашен результат победителя или одно из решений, если последнего не найдётся.
Победителю канхвета "Тузик"%)
← →
Рыжик (2002-12-25 14:54) [1]С учётом порядка или без?
← →
McSimm (2002-12-25 15:06) [2]Делал для студии звукозаписи программу и в ней был подбор вариантов компоновки треков с CD на кассету заданной длительности.
Неделю не могли поверить, что кассету можно точно (а была функция и приблизительного подбора) заполнить сотнями вариантов :)
← →
Сатир (2002-12-25 15:25) [3]2Рыжик © (25.12.02 14:54)
без
то есть
1+2+4=1+2+4=2+1+4=2+4+1=4+2+1=4+1+2
главное, чтоб сумма равнялась К, то есть нужно определить коллекцию множеств, образованных из членов этого ряда, составляющие которых дадут К
← →
Johnmen (2002-12-25 17:35) [4]>McSimm © (25.12.02 15:06)
Абсолютно то же самое писал неск.лет назад ! :)))))))
← →
Dona (2002-12-25 17:45) [5]Да, нам на 1 курсе подобную семестровую задавали :)
← →
Сатир (2002-12-25 18:55) [6]народ, харошь вспоминать приятные мелочи
лучше пусть кто-то решит, тогда и будем делить победителя
← →
Sha (2002-12-25 20:51) [7]2 Johnmen © (25.12.02 17:35)
Писали :)
← →
Jeer (2002-12-25 20:54) [8]Так огласи результ.
За премией дело не встанет.
Вспоможем-с.
← →
Igorek (2002-12-25 21:23) [9]
> Сатир © (25.12.02 14:49)
А словами можно? ;-)
Значит так: делаем перебор всех возможных комбинаций заданного набора чисел обычным рекурсивным способом (недавно была ветка про перебор). По мере заполнения текущей комбинации вычисляем текущую сумму (она равна сумме уже использованных чисел в комбинации). Если текущая сумма превышает заданную, то данная ветка в полном дереве перебора бесперспективная (метод ветвей и границ). Если мы собрали комбинацию, то тогда если текущая сумма равна заданной, то делаем инкремент счетчика.
Счас MBo прочитает и реализует :-)))
← →
Сатир (2002-12-25 22:02) [10]2Jeer © (25.12.02 20:54)
ещё рано, я дал неделю на раздумия
2Igorek © (25.12.02 21:23)
рекурсия и деревья - это всё понятно, но вот когда N и K в районе миллиона, тогда станет вопрос об оптимальном решении
← →
Igorek (2002-12-26 00:29) [11]
> Сатир © (25.12.02 22:02)
> 2Igorek © (25.12.02 21:23)
> рекурсия и деревья - это всё понятно, но вот когда N и K
> в районе миллиона, тогда станет вопрос об оптимальном решении
Ну так вопрос в том и состоит, что бы еще дельше оптимизировать алгоритм. Хотя я напр. не знаю как.
← →
Sha (2002-12-26 10:06) [12]2 Сатир © (25.12.02 14:49)
Неполное описание требований, не определен тестовый пример, не ясен критерий оценки...
Конкретизируй.
зы. А, что, есть такая конфета? Kexit gbdjv :)
← →
Alx2 (2002-12-26 10:48) [13]
procedure TForm1.Button1Click(Sender: TObject);
var
Data: array of integer;
Stop : Integer;
function Solve(Level, Value: Integer): Boolean;
var
k, len: integer;
begin
Result := Value = 0;
if Result then
begin
Memo1.Lines.Add("--------------");
for k := 0 to Length(Data) - 1 do
Memo1.Lines.Add(IntToStr(Data[k]))
end
else
begin
Len := Length(data);
SetLength(Data, Len + 1);
for k := Level to Stop do
begin
Data[Len] := k;
Solve(k + 1, Value - k);
end;
SetLength(Data, Len);
end;
end;
begin
Stop := 6; - Ограничитель "N"
Solve(1, 10); В данном случае K=10
end;
PS
Динамический массив - затычка. Здесь лучше использовать статику
← →
Alx2 (2002-12-26 11:05) [14]Что-то на функцию я запал. Процедуры хватит, конечно же.
procedure TForm1.Button1Click(Sender: TObject);
var
Data: array of integer;
Stop: Integer;
procedure Solve(Level, Value: Integer);
var
k, len: integer;
begin
if Value = 0 then
begin
Memo1.Lines.Add("--------------");
for k := 0 to Length(Data) - 1 do
Memo1.Lines.Add(IntToStr(Data[k]))
end
else
begin
Len := Length(data);
SetLength(Data, Len + 1);
for k := Level to Stop do
begin
Data[Len] := k;
Solve(k + 1, Value - k);
end;
SetLength(Data, Len);
end;
end;
begin
Stop := 6;
Solve(1, 10);
end;
← →
Alx2 (2002-12-26 11:52) [15]И непосредственно ответ на задание:
"есть ряд натуральных чисел от 1 до N ... Определить число комбинаций членов ряда, которые в сумме дадут K. Рассмотреть все варианты."
procedure TForm1.Button1Click(Sender: TObject);
var
Stop: Integer;
function SolveCount(Level, Value: Integer):Integer;
Var k : Integer;
begin
Result := 0;
if Value = 0 then inc(Result)
else
for k := Level to Stop do
inc(Result,SolveCount(k + 1, Value - k));
end;
begin
// Определяем число комбинаций членов ряда, которые в сумме
// дадут 10, если есть ряд натуральных чисел от 1 до 6
Stop := 6;
ShowMessage(SolveCount(1, 10));
end;
← →
Sha (2002-12-26 12:28) [16]2 Alx2 © (26.12.02 11:52)
Надо, вероятно, чуть поправить, чтобы после
Stop := 6;
ShowMessage(SolveCount(1, 0));
было 0, а не 1.
А так - нормально. Правда, время расчетов для больших чисел будет просто огромным.
← →
Alx2 (2002-12-26 12:49) [17]>Sha © (26.12.02 12:28)
Просто нужен контроль входных данных.
У меня перебор "в лоб".
Можно решать еще так, например.
Количество таких разложений = коэфициенты при соответствующих степенях K в выражении (1 + x^1)*(1 + x^2)*(1 + x^3)...(1+x^N) после раскрытия скобок
← →
Sha (2002-12-26 13:11) [18]Alx2 © (26.12.02 12:49)
> Количество таких разложений = коэфициент при x^K в выражении
> (1 + x^1)*(1 + x^2)*(1 + x^3)...(1 + x^N) после раскрытия скобок.
Это очевидно. Осталось его найти :)
← →
Сатир (2002-12-26 13:31) [19]2Sha © (26.12.02 10:06)
>зы. А, что, есть такая конфета? Kexit gbdjv :)
отсылаю к творчеству Леся Подеревьянського
http://www.slovnyk.org/txt/poderev/_single/hamlet.html
"Пилите, Шура, пилите" (с)Ильф и Петров. "Золотой Телёнок"
2Alx2 © (26.12.02 12:49)
вообщем, Вы, судя по всему, очень близки к истине, но дадим ещё пару дней, может кто-то и предложет ещё несколько красивых решений
← →
Alx2 (2002-12-26 13:33) [20]>Sha © (26.12.02 13:11)
Ассимптоматика известна
a(n)~1/12*exp(1/12*pi*sqrt(144*n-6)*sqrt(3))*3^(3/4)/((n-1/24)^(3/4)) (результат не мой, естстественно. Но на что сослаться - не помню)
← →
Sha (2002-12-26 13:40) [21]2 Сатир © (26.12.02 13:31)
Kexit gbdjv :)
← →
Сатир (2002-12-26 13:55) [22]2Sha © (26.12.02 13:40)
ну, эт само собой:)
← →
Alx2 (2002-12-26 14:24) [23]>Сатир © (26.12.02 13:55)
>вообщем, Вы, судя по всему, очень близки к истине, но дадим ещё
>пару дней, может кто-то и предложет ещё несколько красивых
>решений
Халява, сэр :)) Но я польщен, хотя и не удосужился до истины дотянуться:) Кстати, на что вам сдались комбинаторные взрывы? (Это про "Рассмотреть все варианты", факториалы - рулез форева?)
И что породило такую задачу (воспитательные задачи от преподов - не аргумент)?
← →
Сатир (2002-12-26 14:54) [24]2Alx2 © (26.12.02 14:24)
решил тряхнуть стариной%)
← →
Sha (2002-12-26 15:16) [25]Мой вариант:
procedure TForm1.Button3Click(Sender: TObject);
function SolveCount(MaxNo, Sum: Integer):Integer;
var
No: integer;
begin;
Result:=0;
for No:=MaxNo downto 1 do if No=Sum then inc(Result)
else if No<Sum then inc(Result,SolveCount(No-1, Sum-No));
end;
begin;
ShowMessage(IntToStr(SolveCount(32, 32))+" "+IntToStr(Ct));
end;
Он корректно обрабатывает нулевую сумму и значительно эффективнее на больших числах, хотя тоже не подарок.
← →
Sha (2002-12-26 15:20) [26]
+" "+IntToStr(Ct)надо удалить - замерял произодительность.
← →
Alx2 (2002-12-26 15:27) [27]>Sha © (26.12.02 15:16)
>и значительно эффективнее на больших числах, хотя тоже не
>подарок.
Да.. разница на порядки. Надо же, я как тот пост написал, то и думать над задчкой перестал а надо было бы. Теперь придется переплевывать, что вряд ли получится :))
← →
Sha (2002-12-26 17:03) [28]Более эффективный (примерно в 2 раза), хотя и менее красивый вариант:
procedure TForm1.Button4Click(Sender: TObject);
function SolveCount(No, Sum: integer): integer;
begin;
Result:=0;
if No>=Sum then begin;
inc(Result);
No:=Sum-1;
end;
while No>1 do begin;
inc(Result,SolveCount(No-1, Sum-No));
dec(No);
end;
end;
begin;
ShowMessage(IntToStr(SolveCount(25, 25)));
end;
← →
MBo (2002-12-26 18:09) [29]
type
TByteSet=set of byte;
const n=20;
m=60;
...
procedure TForm1.Button1Click(Sender: TObject);
var b,bmin:byte;
nn:cardinal;
nfull:int64;
function MinByte(b1:Byte;b2:Cardinal):Byte;
begin
if b1>b2 then
Result:=byte(b2)
else
Result:=b1;
end;
procedure PrintSet(BSet:TByteSet);
var bb,cb:byte;
s:string;
nf:cardinal;
begin
inc(nn);
cb:=0;
s:="";
for bb:=1 to n do
if bb in BSet then begin
s:=s+Format("%-3d",[bb]);
inc(cb);
end;
Memo1.Lines.Add(s);
nf:=1;
for bb:=2 to cb do
nf:=nf*bb;
inc(nfull,nf);
end;
procedure FindIt(StartSet,SumSet:TByteSet; Sum:Integer);
var bb:byte;
begin
for bb:=1 to bmin do
if bb in StartSet then begin
Exclude(StartSet,bb);
if bb=Sum then
PrintSet(SumSet+[bb])
else
if bb<Sum then
FindIt(StartSet,SumSet+[bb],Sum-bb);
end;
end;
begin
Memo1.Clear;
bmin:=MinByte(n,m);
nn:=0;
nfull:=0;
Memo1.Lines.BeginUpdate;
for b:=1 to bmin do
FindIt([b+1..bmin],[b],m-b);
Memo1.Lines.EndUpdate;
Memo1.Lines.Add("Variants: "+IntToStr(nn));
Memo1.Lines.Add("With permutations: "+IntToStr(nfull));
end;
← →
MBo (2002-12-26 18:14) [30]чуть быстрее
procedure FindIt(StartSet,SumSet:TByteSet; Sum:Integer);
var bb:byte;
begin
for bb:=1 to bmin do
if bb in StartSet then begin
Exclude(StartSet,bb);
Include(SumSet,bb);
if bb=Sum then
PrintSet(SumSet)
else
if bb<Sum then
FindIt(StartSet,SumSet,Sum-bb);
Exclude(SumSet,bb);
end;
end;
← →
MBo (2002-12-26 18:19) [31]service pack #2 ;)
if bb=Sum then
PrintSet(SumSet)
else
if bb<Sum then
FindIt(StartSet,SumSet,Sum-bb)
else Break;
← →
Сатир (2002-12-26 19:14) [32]2MBo © (26.12.02 18:19)
Спасибо за ответы
Рад Вас видеть
← →
Sha (2002-12-27 08:42) [33]Я тут немного поразмыслил - и резвость проги повысилась еще в два раза.
Теперь на моем 500 MHz компьютере расчет SolveCount(200,200) занимает чуть более 1 минуты (а это ~500.000.000 вариантов). Т.е. реально с ее помощью точно вычислять значения вплоть до MaxInt. По-моему, этого достаточно.
Кому мало - скажу: есть еще очень серьезные резервы (намек содержится в измененном тексте программы), но для их использования потребуется перевести программу в другую весовую категорию.
function SolveCount(No, Sum: integer): integer;
begin;
Result:=0;
case (((No+1)*No) shr 1)-Sum of
0..2: Result:=1;
3: Result:=2;
4..MaxInt: begin;
if No>=Sum then begin;
inc(Result);
No:=Sum-1;
end;
while No>1 do begin;
inc(Result,SolveCount(No-1, Sum-No));
dec(No);
end;
end;
end;
end;
← →
Сатир (2002-12-27 13:56) [34]2Sha © (27.12.02 08:42)
Отлично
2All
Тогда предлагается из предложенных вариантов путём незначительных изменений предложить самый шустрый вариант
Успехов
← →
Novice (2002-12-27 14:14) [35]2 Сатир © (27.12.02 13:56)
A потом самый шустрый из самых шустрых :)
← →
Сатир (2002-12-27 15:26) [36]2Novice © (27.12.02 14:14)
я могу взять на себя роль жюри и вынести окончательного победителя
← →
Сатир (2002-12-27 17:01) [37]2 ALL
Вообщем, ситауция такая: мой коллега по работе дал мне эту задачку, я её с горем пополам решил, и потом встал вопрос оптимизации.
В соревнованиях участвуют
1)Solaris, Ultra Spark 500 Mhz один камень -это у моего коллеги
2)Пень 450 Мгц - это у меня + ваши идеи;)
Вообщем, кто быстрее
← →
Сатир (2002-12-27 17:57) [38]2MBo © (26.12.02 18:14)
у человека на спарке, который раза в четыре медленее моего пня, правда написано на сях, работает при k=215, n=32 моментально, а у меня думает:(
обидно:)
← →
MBo (2002-12-27 18:02) [39]>Сатир
В чем конкретно задача, что делает его программа?
Получить и вывести список вариантов или просто посчитать их?
← →
Sha (2002-12-27 18:26) [40]2 Сатир © (27.12.02 17:57)
Применение кривого (параболического) зеркала увеличивает производительность еще на четверть:
50 сек. для k=200, n=200 на 500 MHz,
~2 сек. для k=215, n=32 на 500 MHz.
function SolveCount(No, Sum: integer): integer;
var
SumMax: integer;
begin;
Result:=0;
SumMax:=(((No+1)*No) shr 1);
if Sum<=SumMax then begin;
dec(SumMax,Sum);
if Sum>SumMax then Sum:=SumMax;
if Sum<5 then Result:=(Sum+5) shr 2
else begin;
if No>=Sum then begin;
inc(Result);
No:=Sum-1;
end;
while No>1 do begin;
inc(Result,SolveCount(No-1, Sum-No));
dec(No);
end;
end;
end;
end;
Этот алгоритм можно еще оптимизировать:
1. использовать заранее расчитанные таблицы, чтобы устранить толчею на малых числах,
2. запоминать результаты предыдущих вычислений, чтобы не вычислять повторно одно и то же,
3. переписать на Asm.
Дальше двигаться можно уже самостоятельно :)
Страницы: 1 2 вся ветка
Форум: "Потрепаться";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.01 c
