
14.09.2007, 02:41
|
|
Постоянный
Регистрация: 11.03.2007
Сообщений: 581
Провел на форуме: 4172659
Репутация:
646
|
|
Вот как эту зудучу решил я, код на Делфи (о ней же все-таки тема). Для наглядности рисую и доски, хотя это не нужно, главное - число.
Код:
program Ferzi;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
Ferz = '*';
Empty = '1';
War = '0';
N=4;
type
TDoska = array[1..N, 1..N] of char;
var
Count: word;
Dos: TDoska;
function SetFerz(D: TDoska; i,k: word): TDoska;
var
i1,k1: word;
begin
result := D;
if (i>N)or(k>N) then exit;
if result[i,k]<>Empty then exit;
for i1:=1 to n do
for k1:=1 to n do
begin
if result[i1,k1]=Empty then
begin
if (i1 = i)or(k1 = k) then result[i1,k1] := War;
if (i1-i=k1-k) then result[i1,k1] := War;
if (k1+i1=i+k) then result[i1,k1] := War;
end;
end;
result[i,k] := Ferz;
end;
procedure ShowDoska(D: TDoska);
var
i,k: word;
begin
for i := 1 to n do
begin
writeln;
for k:=1 to n do
write(D[i,k]:2);
end;
writeln;
end;
procedure Perestanovka(D: TDoska; h, c: integer);
var
i,k: word;
begin
if c = N then
begin
ShowDoska(D);
inc(Count);
end;
for k := 1 to N do
begin
if h < N then
if D[h+1,k]=Empty then
Perestanovka(SetFerz(D,h+1,k),h+1,c+1);
end;
end;
begin
FillChar(Dos,sqr(N),Empty);
Perestanovka(Dos, 0, 0);
writeln(#13#10,Count);
readln;
end.
Решал ее в прошлом году, признаюсь, поначалу никаких идей по поводу решения не было. А теперь о фактах. Эта задача была в финале чемпионата мира по программированию 1989 года 
|
|
|