Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

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

Помогите решить задачу про ферзей!
На доске 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
Репутация: 920
По умолчанию

Можно сделать < 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
Репутация: 920
По умолчанию

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

Код:
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
Репутация: 10
По умолчанию Спасибо

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

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

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

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

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

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


15:33.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.