Текущий архив: 2002.04.18;
Скачать: CL | DM;

Вниз

Задачка...   Найти похожие ветки 

← →
Ajax ©   (2002-03-07 17:55) [0]

Мне недавно предложили решить задачку. Нужно указать все варианты перестановок из 8 цифр и положить все это в файл, одна строчка - одна перестановка. А в конце задачи небольшое уточнение - программа должна работать не более 10 секунд. Вот тут то и выходит прокол. Прогу я написал, только вот работает она на PIII 500MHz около 3 минут. Я делал в лоб - перебирал все восьмизначные числа и выбирал нужные. Может есть какой-нибудь алгоритм побыстрее?

---

← →
Фэ ©   (2002-03-07 18:02) [1]

Шо ?
В шесть часов вечера перед войной ?
Тебе предложили, Это ?
Тебе о Женщинах сегодня думать, и не только, надо.
Брось все, кроме них.
Они этого стоят !!!

---

← →
ghost_by ©   (2002-03-07 18:14) [2]

Может есть какой-нибудь алгоритм побыстрее? - Конечно есть - рекурсия, по идее на порядок быстрее будет.

---

← →
Ajax ©   (2002-03-07 18:35) [3]

2Фэ: ИМХО 8 марта только завтра, или нет? Хотя ты прав, конечно. :)
2ghost_by: может объяснишь, а то что-то не догоняю.

---

← →
VuDZ ©   (2002-03-07 18:41) [4]

я думаю Кнут спасёт отца русской демократии - там всё хорошо о перестановках написано

---

← →
McSimm ©   (2002-03-07 18:45) [5]

Задачка на 5 минут. У нас тут праздник на фирме, я между стопками набросал :)
На моем компьютере работает 00мин:00сек
Если чего не так сделал - предупреждаю, начал после 3й :)

procedure TForm1.Button1Click(Sender: TObject);
var F: TextFile;
T1: TDateTime;
type
TDigitSet = Set of Char;

procedure OutStr(const S: String);
begin
Writeln(F, S)
end;

procedure Req(const S: String; St: TDigitSet);
var C: Char;
begin
if Length(S) = 8 then
begin
OutStr(S);
Exit
end;
for C := "1" to "8" do
if not (C in St) then
Req(S+C, St+[C])
end;
begin
AssignFile(F, "e:\Digits.txt");
Rewrite(F);
try
T1 := Now;
Req("", []);
Label1.Caption := FormatDateTime("nn:ss", Now-T1)
finally
CloseFile(F)
end
end;

---

← →
Ajax ©   (2002-03-08 09:33) [6]

Хоть убей не могу понять, почему код от McSimm работает. Ведь в множество St постоянно включаются элементы, а чтобы они удалялись я не вижу. Объясните плз.

---

← →
Mystic ©   (2002-03-08 15:37) [7]

А они не удаляются. Максимальная глубина рекурсии - 8. На каждом шаге есть свои S и St. Как только мы их полностью заполнили (перебрали все варианты заполения), мы выводим результат и возвращаемся на шаг назад.

---

← →
McSimm ©   (2002-03-10 11:55) [8]

>Хоть убей не могу понять, почему код от McSimm работает.

Это что, у меня бывает так, что хоть убей не могу понять почему собственный код работает !!!

Маленький совет. Переделай программу для диапазона "1".."3":
if Length(S) = 3...for C := "1" to "3", поставь точку прерывания на процедуру, добавь входные параметры St и S в Watch-list. Это поможет сразу разобраться в принципе работы рекурсии лучше любых объяснений.

Кстати, приведенный выше код можно упростить и обойтись без St. Правда за счет быстродействия - раза в 2-3 дольше, но все равно меньше секунды:
procedure TForm1.Button1Click(Sender: TObject);
var F: TextFile;
T1: TDateTime;
procedure Req(const S: String);
var C: Char;
begin
if Length(S) = 8 then Writeln(F, S)
else
for C := "1" to "8" do
if Pos(C, S) = 0 then
Req(S+C)
end;
begin
AssignFile(F, "e:\Digits.txt");
Rewrite(F);
try
T1 := Now;
Req("");
Label1.Caption := FormatDateTime("nn:ss.z", Now-T1)
finally
CloseFile(F)
end
end;

---

Страницы: 1 вся ветка

Текущий архив: 2002.04.18;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.013 c