Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 07.10.2008, 17:16   #1
yuran80
 
Регистрация: 07.10.2008
Сообщений: 3
Стрелка Решение задачи про ферзей

Помогите решить задачу про ферзей!
На доске NxN ужно разместить N ферзей так чтобы они не били один другого!То есть не находились на одной вертикали, горизонтали или диагоналях! Delphi - Object Pascal
Решение уже есть но нужно чтобы считало быстрее! Для 15 ферзей меньше 20 сек
Помогите
[code] program ferz;

{$APPTYPE CONSOLE}
uses
SysUtils;

type
Tmasiv = Array of word;

var
N : integer;
Rez: Extended;
M : Tmasiv;
tim : Double;
t: word;

function Ferz(x,y: word) : Boolean;
var
i: word;
begin
i:=1;
while (i < x) and (y <> M[i]) and (abs(x - i) <> abs(y - M[i])) do inc(i);
Ferz := i=x;
end;

procedure Go(x: word);
var
y : word;
begin
if x=1 then
begin
if odd(n)=false then t:=round(n/2);
if odd(n)=true then t:=round((n-1)/2+1);
for y := 1 to t do
if Ferz(1, y) then
begin
M[1] := y;
Go(x+1);
end;
end
else
for y := 1 to N do
if Ferz(x, y) then
begin
M[x] := y;
if x = N then
begin
if (odd(n)=true) and (m[1]=t) then rez:=rez+1/2
else
Rez:=rez+1;
end;
Go(x+1);
end;

end;

begin

Readln(N);
SetLength(M,N);
tim:=Now;
Rez := 0;
Go(1);
Writeln(Rez*2:8:0);
Writeln(TimeToStr(Now-tim));
Readln;

end. [code]

Последний раз редактировалось yuran80; 07.10.2008 в 17:24. Причина: А вот и код
yuran80 вне форума Ответить с цитированием
Старый 08.10.2008, 09:33   #2
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Можно сделать < 20 сек., если учесть симметрию.
Я не стал разбираться с Вашим кодом - написал свой. Вот исходный вариант:

Код:
const N = 15;

var m  : array [1..N] of integer;
    d1 : array [2..2*n] of boolean;   // Диагонали
    d2 : array [-N..N] of boolean;    // Диагонали

var count : integer;

procedure getPosition(P:integer);
var x:integer;
begin
   for x := 1 to N do begin
      if (m[x] <> 0) or d1[P+x] or d2[P-x] then continue;

      if P = N
      then inc(count)
      else begin
         m[x]  := P;
         d1[P+x] := true;
         d2[P-x] := true;

         getPosition(P+1);

         m[x] := 0;
         d1[P+x] := false;
         d2[P-x] := false;
      end;
   end;
end;

var T:DWORD;
begin
   T := getTickCount;
   fillChar(m, sizeOf(m), 0);
   fillChar(d1, sizeOf(m), 0);
   fillChar(d2, sizeOf(m), 0);
   count := 0;
   getPosition(1);
   writeln(count, (GetTickCount-T) div 1000:8);

   readln;
end.
Этот код считает чуть больше 20 сек. для N=15
alexBlack вне форума Ответить с цитированием
Старый 08.10.2008, 09:35   #3
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Теперь на первом уровне учтем осевую симметрию:

Код:
const N = 15;

var m  : array [1..N] of integer;
    d1 : array [2..2*n] of boolean;   // Диагонали
    d2 : array [-N..N] of boolean;    // Диагонали

var count, countp : integer;

procedure getPosition(P:integer);
var x, nn:integer;
begin
   nn := N;
   if P = 1 then begin
      nn := N div 2;
      if N mod 2 > 0 then inc(nn);
   end;

   for x := 1 to nn do begin
      if P = 1 then writeln(x);
      
      if (m[x] <> 0) or d1[P+x] or d2[P-x] then continue;

      if (P = 1) and (x = nn) and (N mod 2 > 0)
      then countp := count;

      if P = N
      then inc(count)
      else begin
         m[x]  := P;
         d1[P+x] := true;
         d2[P-x] := true;

         getPosition(P+1);

         m[x] := 0;
         d1[P+x] := false;
         d2[P-x] := false;
      end;

      if (P = 1) and (x = nn) and (N mod 2 > 0)
      then count := count + countp;
   end;
end;

var T:DWORD;
begin
   T := getTickCount;
   fillChar(m, sizeOf(m), 0);
   fillChar(d1, sizeOf(m), 0);
   fillChar(d2, sizeOf(m), 0);
   count := 0;
   getPosition(1);
   if N mod 2 = 0 then count := count * 2;
   writeln(count, (GetTickCount-T) div 1000:8);

   readln;
end.
теперь для N=15 время - 12-15 сек.
alexBlack вне форума Ответить с цитированием
Старый 08.10.2008, 12:27   #4
yuran80
 
Регистрация: 07.10.2008
Сообщений: 3
По умолчанию Спасибо

Но у меня пишет ошибку, что незнает getTickCount!
Задача нужна для делфи!
yuran80 вне форума Ответить с цитированием
Старый 08.10.2008, 12:52   #5
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Цитата:
Сообщение от yuran80 Посмотреть сообщение
Но у меня пишет ошибку, что незнает getTickCount!
Задача нужна для делфи!
Это и есть Delphi. Сверху:

Код:
{$APPTYPE CONSOLE}
uses Windows;
alexBlack вне форума Ответить с цитированием
Старый 08.10.2008, 12:59   #6
yuran80
 
Регистрация: 07.10.2008
Сообщений: 3
По умолчанию

Да спасибо! Это я что-то напутал!Извини! Голова не варит, целую ночь проги писал!
yuran80 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Си - Решение задачи про многоугольник и точку andreas Помощь студентам 1 27.05.2008 19:29
Решение задачи на c++ JOFRIF Помощь студентам 2 21.04.2008 00:35
Решение задачи на Си kisha Общие вопросы C/C++ 9 19.11.2007 23:31
решение задачи TuNeR Microsoft Office Excel 2 15.10.2007 09:31