Расстановки ладей на шахматной доске

← →
rena © (2008-05-13 00:22) [0]

Задача: Написать программу, выдающую все возможные способы расстановки ладей на шахматной доске, при которых ни одна ладья не угрожает другой
[CODE]
var
Form1: TForm1;
Q:array [1..8] of 1..8;
H:array [1..8] of boolean;
j,t,k:integer;
p:boolean;

procedure TForm1.Button1Click(Sender: TObject);
begin
//Заполнение
for j:=1 to 8 do
begin
H[j]:=true;
end;

Ladya8(1);
end;

procedure TForm1.Ladya8(k: integer);
var j:0..8;
begin
j:=0;
repeat //гориз <>8
j:=j+1;
if H[j] then //если гориз не под боем
begin
Q[k]:=j;
H[j]:=false;
if k<=8 then
begin
Memo1.Lines.Add("("+inttostr(k)+","+inttostr(j)+")");
Ladya8(k+1);
end
else
H[j]:=true;

end;
until j=8;

end;

[/CODE]
Программа выдает только один вариант расстановки -
(1,1)
(2,2)
(3,3)
(4,4)
(5,5)
(6,6)
(7,7)
(8,8)
для того чтобы выводились все варианты, вроде бы нужно добавить цикл, но от этого результ становится ещё хуже. Плиз, подскажите куда и по какому элементу его вставлять? По j?
И ещё вопрос: при задании графа с помощью матрицы связности как можно описать его тип? Как запись?

← →
Игорь Шевченко © (2008-05-13 00:52) [1]

а может для начала словами описать ?

← →
Германн © (2008-05-13 01:14) [2]

> Игорь Шевченко © (13.05.08 00:52) [1]
>
> а может для начала словами описать ?
>

Угу. Да и умение строить блок-схемы алгоритмов тоже бы не помешало. Хоть это уже почти забытое искусство. :(((

← →
Sha © (2008-05-13 11:05) [3]

Ладьи переставлять необязательно,
достаточно просто генерировать перестановки.

Решений в инете тьма.

← →
Vlad Oshin © (2008-05-13 11:37) [4]

таких вариантов очень много
набросал быстренько:

procedure TForm1.Button1Click(Sender: TObject); var i:array[1..8] of byte; i1:byte; j1,j2,j3,j4, j5,j6,j7,j8:byte; s:string; Function NoAttack:boolean; var i1,i2:byte; a:array[1..8,1..8] of byte; begin result:=true; ZeroMemory(addr(a),sizeof(a)); for i2:=1 to 8 do for i1:=1 to 8 do if a[i1,i[i2]]=1 then begin result:=false; exit; end else a[i1,i[i2]]:=1; end; begin for j1:=1 to 8 do for j2:=1 to 8 do for j3:=1 to 8 do for j4:=1 to 8 do for j5:=1 to 8 do for j6:=1 to 8 do for j7:=1 to 8 do for j8:=1 to 8 do begin i[1]:=j1; i[2]:=j2; i[3]:=j3; i[4]:=j4; i[5]:=j5; i[6]:=j6; i[7]:=j7; i[8]:=j8; if NoAttack then begin s:=""; for i1:=1 to 8 do s:=s+"("+inttostr(i1)+","+inttostr(i[i1])+")"; memo1.Lines.Add(s); memo1.Lines.Add("---------"); end; end; end;

Текстовый файл на 2 метра получился :)

← →
Vlad Oshin © (2008-05-13 11:37) [5]

Удалено модератором

← →
Vlad Oshin © (2008-05-13 11:37) [6]

Удалено модератором

← →
Sha © (2008-05-13 11:59) [7]

> Vlad Oshin © (13.05.08 11:37) [6]

Количество безрезультатных прогонов цикла можно заметно уменьшить,
ведь мы имеем всего 8! перестановок
procedure TForm1.Button1Click(Sender: TObject); var c, d: array[0..7] of integer; f, i, j, k, m, n: integer; begin; Memo1.Text:=""; c[0]:=0; for n:=0 to 8*7*6*5*4*3*2*1-1 do begin; m:=n; for i:=1 to 7 do begin; c[i]:=m mod (i+1); m:=m div (i+1); end; m:=0; for i:=7 downto 0 do begin; k:=c[i]; j:=0; f:=1; while true do begin; if m and f=0 then begin; dec(k); if k<0 then break; end; inc(j); f:=f+f; end; m:=m or f; d[i]:=j; end; Memo1.Lines.Add(Format("%5d 0%d 1%d 2%d 3%d 4%d 5%d 6%d 7%d", [n, d[7],d[6],d[5],d[4],d[3],d[2],d[1],d[0]])); end; end;

← →
rena © (2008-05-16 21:09) [8]

Решений в результате должно получиться 92. А улучшить требуется именно эту задачу, к сожалению. (+ должна обязательно присутствовать рекурсия) Пробовала усовершенствовать - не выходит.

← →
DVM © (2008-05-16 21:19) [9]

> Vlad Oshin © (13.05.08 11:37) [6]

> таких вариантов очень много

у вас 3 варианта и все одинаковые :)

← →
MBo © (2008-05-16 21:47) [10]

>Решений в результате должно получиться 92
Похоже, что кто-то путает ладей с ферзями :)

← →
rena © (2008-05-16 22:00) [11]

ой)) да) Извиняюсь~_^ Но все же как именно эту функцию усовершенствовать - не знаю) Запуталась совсем..

← →
MBo © (2008-05-17 11:40) [12]

TRookSet = set of "A".."H"; procedure ArrangeRooks(Horiz: Byte; Rooks: TRookSet; Line: string); var RookChar: Char; begin if Horiz > 8 then PrintLine(Line) else for RookChar := "A" to "H" do if not (RookChar in Rooks) then ArrangeRooks(Horiz + 1, Rooks + [RookChar], Line + RookChar + IntToStr(Horiz) + " "); end; Вызов ArrangeRooks(1, [], "");

Выводятся все 40320 расстановок
Если исключать повороты и отражения, то их будет 5282

> MBo © (17.05.08 11:40) [12]

Да, с множеством намного красивее.

> rena © (16.05.08 22:00) [11]

Препод должен быть в восторге.
Но он, гад, может еще спросить на что в процедуре уходит много времени :-)

Я имел ввиду поцедуру [12], конечно.

>Sha

>на что в процедуре уходит много времени \
В данном случае всего 40 тыс результатов, и выполняется, конечно, мгновенно.

А вот еще интересно, как бы изящно отсечь симметричные варианты.
Например, симметричных относительно верт. оси вариантов легко избежать циклом from "A" to "D", а есть ли более общие приемы?

> MBo ©

> мгновенно

Конечно.
Я на другое хотел обратить внимание студентов. Когда машины были большими, программист немало времени уделял эффективности алгоритма и часто приходилось его вылизывать, чтобы он работал в более-менее приемлемое время. Сейчас с этим посвободнее, но учить этому переставать не стоит, иначе такого нагородят... :-)
Просто хотел подчеркнуть, если этого не сделает препод, что сцепление строк - не самая быстрая операция (приходилось видеть реализации Base64 с посимвольным сцеплением), что включение элемента в множество ребятам из Борланда не совсем удалось (лучше пара Include/Exclude), что каждый раз применяя рекурсию имеет смысл смотреть в CPU Window (хотя был у меня случай, когда рекурсивная программа на AMD-500 обгоняла нерекурсивную на P4-2,4 - но это, все-таки исключение, а не правило).

> отсечь симметричные варианты
Понятно, что скорее всего в данном случае, отсечение только затормозит.
Имеет смысл его применять, когда без этого задача становится тяжелой (не "пролезает" по памяти или по скорости). Например, на сходных задачах задачах (кубик Рубика) это прекрасно продемонстрировали Косиемба и другие. Общие приемы, конечно, есть. Определяем какие есть симметрии, выделяем зоны симметрии, вводим нумерацию, строим таблицы переходов между состояниями, если требуется (например, для кубика Рубика). Все от задачи зависит.

Большое спасибо всем! Задачу преобразовала^_^ правда, пока все варианты в Memo выведет, приходится около минуты ждать))

Расстановки ладей на шахматной доске Найти похожие ветки