Форум: "Потрепаться";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];
Вниз
Задача для разминки мозгов Найти похожие ветки
← →
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.
Дальше двигаться можно уже самостоятельно :)
← →
Sha (2002-12-27 20:26) [41]Убрал умножения и рекурсивные обращения за нулевым результатом.
Шустрость повысилась на 40% :
30 сек. для k=200, n=200 на 500 MHz,
1.3 сек. для k=215, n=32 на 500 MHz.
procedure TForm1.Button18Click(Sender: TObject);
var
Ticks: integer;
Count: integer;
function SolveCount2(No, Sum: integer): integer;
var
Sq: array[1..1000] of integer;
SqNo: integer;
function SolveCount(No, Sum: integer): integer;
begin;
Result:=0;
if Sum>Sq[No]-Sum then Sum:=Sq[No]-Sum;
if Sum<5 then Result:=(Sum+5) shr 2
else begin;
if No>=Sum then begin;
inc(Result);
No:=Sum-1;
end;
while Sq[No]>=Sum do begin;
inc(Result,SolveCount(No-1, Sum-No));
dec(No);
end;
end;
end;
begin;
Result:=0;
if (No>0) and (Sum>0) and (Sum<=(No*(No+1)) shr 1) and (No<High(Sq)) then begin;
for SqNo:=1 to No do Sq[SqNo]:=(SqNo*(SqNo+1)) shr 1;
Result:=SolveCount(No, Sum);
end;
end;
begin;
Ticks:=GetTickCount;
//Count:=SolveCount2(200, 200);
Count:=SolveCount2(32, 215);
Ticks:=GetTickCount-Ticks;
ShowMessage(IntToStr(Count)+" "+IntToStr(Ticks));
end;
← →
Sha (2002-12-27 23:33) [42]Близится конец отпущенного срока... А решения все нет...
Представляю главного претендента, выступающего в тяжелой весовой категории.
function SolveCount(No, Sum: integer): integer;
var
Cnt: array of integer;
CntX, NoX, Sum1, Sum2, SumX: integer;
begin;
if (No<=0) or (Sum<=0) or (Sum>(No*(No+1)) shr 1) then Result:=0
else begin;
if No>Sum then No:=Sum;
SetLength(Cnt,((No*(No+1)) shr 1)+1);
Sum2:=0; Cnt[0]:=1;
for NoX:=1 to No do begin;
Sum1:=Sum2; inc(Sum2,NoX);
for SumX:=Sum2 downto NoX do begin;
CntX:=Cnt[SumX-NoX];
if SumX<=Sum1 then inc(CntX,Cnt[SumX]);
Cnt[SumX]:=CntX;
end;
end;
Result:=Cnt[Sum];
Cnt:=nil;
end;
end;
Все будет посчитано за несколько миллисекунд.
Первый догадается, как это делается, получает половину обещанного приза :)
← →
Sha (2002-12-28 10:33) [43]Полученное решение имеет смысл оптимизировать по памяти. Можно использовать применявшиеся ранее методы оптимизации (зеркало, отсечение угла и отсечение основания). Это даст также некоторый прирост производительности.
Вариант решения, приведенный ниже, за несколько миллисекунд вычисляет 64-битный результат для любого No при затратах памяти ~8*Sum байт.
procedure TForm1.Button19Click(Sender: TObject);
type
TSolveCount= int64;
var
Count: TSolveCount;
Ticks: integer;
function SolveCount(No, Sum: integer): TSolveCount;
var
Cnt: array of TSolveCount;
NoX, Sum1, Sum2, Sum3, SumX: integer;
begin;
Sum2:=(No*(No+1)) shr 1;
if (No<=0) or (Sum<=0) or (Sum>Sum2) then Result:=0
else begin;
repeat;
if Sum>Sum2-Sum then Sum:=Sum2-Sum;
if No>Sum then No:=Sum;
Sum1:=Sum2;
Sum2:=(No*(No+1)) shr 1;
until Sum1=Sum2;
SetLength(Cnt,Sum+1);
Sum2:=0; Cnt[0]:=1;
for NoX:=1 to No do begin;
Sum1:=Sum2; inc(Sum2,NoX); if Sum2<Sum then Sum3:=Sum2 else Sum3:=Sum;
for SumX:=Sum3 downto NoX do
if SumX>Sum1
then Cnt[SumX]:=Cnt[SumX-NoX]
else inc(Cnt[SumX],Cnt[SumX-NoX]);
end;
Result:=Cnt[Sum];
Cnt:=nil;
end;
end;
← →
Сатир (2002-12-28 13:27) [44]2Sha © (27.12.02 18:26)
мой коллега мне сказал, что бутылочным горлышком является использование рекурсии. Эту задачу, оказывается, можно решить без неё, так что лучше измени алгоритм, чем улучшай старый. Само использование рекурсии даёт большую задержку в вычислениях. По его словам, все берутся решать эту задачу сначала через рекурсию и решают в последствии, но для большых чисел это очень медлительный метод.
Теперь осталось выяснить, есть ли у кого идеи, как решить его без использования алгоритма рекурсии.
← →
Sha (2002-12-28 19:47) [45]2 Сатир © (28.12.02 13:27)
А где тут рекурсия?
Смотри внимательно Sha © (28.12.02 10:33).
Находит решение за 0 тиков.
← →
Сатир (2002-12-28 19:57) [46]2Sha © (28.12.02 19:47)
снимаю шляпу, потерял бдительность:(, стар, супер-стар
"За премией дело не встанет."Jeer © (25.12.02 20:54)
Вспоможем-с.
← →
Сатир (2002-12-28 20:35) [47]2Sha © (28.12.02 19:47)
ладно, а теперь посчитайте своё творение при 10000, 10000.
Получим переполнение стека:(. Есть идеи как это обойти?
← →
Sha (2002-12-28 20:50) [48]Не стека, а разрядной сетки. Для заданного No максимум значения функции приходится на Sum=(No*(No-1)) shr 2. Даже 64-битных чисел хватает только на вычисления без переполнения до No=71.
← →
Сатир (2002-12-28 20:53) [49]2Sha © (28.12.02 20:50)
сорри, грешу понятиями
а коду отсыпите?
← →
Sha (2002-12-28 20:56) [50]Длинные числа имеются ввиду? Этого добра везде навалом. Поищи.
← →
Сатир (2002-12-28 20:59) [51]2Sha © (28.12.02 20:56)
та ну, преобразовывать в строку... нам такое давали на школьной олимпиаде по информатике
А коллега грит, что напишет это на питоне, там можно задавать целые до бесконечности... вот так.
← →
Sha (2002-12-28 21:02) [52]Какие строки? Зачем? Посмотри реализацию типа int64 через тип integer.
← →
Сатир (2002-12-28 21:16) [53]ушёл посмотреть
Страницы: 1 2 вся ветка
Форум: "Потрепаться";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];
Память: 0.55 MB
Время: 0.01 c
