Показать сообщение отдельно

  #40  
Старый 14.09.2007, 02:41
Joker-jar
Постоянный
Регистрация: 11.03.2007
Сообщений: 581
Провел на форуме:
4172659

Репутация: 646


Отправить сообщение для Joker-jar с помощью ICQ
По умолчанию

Вот как эту зудучу решил я, код на Делфи (о ней же все-таки тема). Для наглядности рисую и доски, хотя это не нужно, главное - число.
Код:
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 года