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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 20.12.2011, 22:54   #1
Katrina*
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 29
Вопрос задача про шахматную доску

Задается шахматная доска NxM. Нужно вывести максимальное количество ферзей, которых можно расставить так, чтобы они не били друг друга.
Katrina* вне форума Ответить с цитированием
Старый 20.12.2011, 23:53   #2
Xardas
Сисадмин
Форумчанин
 
Аватар для Xardas
 
Регистрация: 28.12.2007
Сообщений: 320
По умолчанию

Код:
uses
  SysUtils;


Const N = 8; // Клеток
      M = 8; // Ферзей

Type Queen = record
           X,Y : Integer;
     End;

Var A : Array[1..N, 1..N] Of Integer;
    K : Array[1..M] Of Queen;
    I,J,Q,X,Y : Integer;

Procedure ClearQueen;
Var I : Integer;
Begin
     For I := 1 To M Do
     Begin
          K[I].X := 0;
          K[I].Y := 0;
     End;
End;

Procedure ShowQueen;
Var I : Integer;
Begin
     For I := 1 To M Do
         WriteLn('Q',I, ' [', K[I].X, ',', K[I].Y, ']');
End;

Procedure SetQueen;
Begin
     For I := 1 To M Do
         If (K[I].X <> 0) And (K[I].Y <> 0) Then
            A[K[I].X, K[I].Y] := I;
End;

Procedure ClearArray;
Var I,J : Integer;
Begin
     For I := 1 To N Do
         For J := 1 To N Do
             A[I, J] := 0;
End;

Procedure ShowArray;
Var I,J : Integer;
Begin
     For I := 1 To N Do
     Begin
         For J := 1 To N Do
             Write(A[I, J]:3);
         WriteLn;
     End;
End;

Procedure SetArray(X,Y : Integer);
Var I,J : Integer;
Begin
     For I := 1 To N Do Inc(A[I,Y]);
     For I := 1 To N Do Inc(A[X,I]);
     For I := -N To N Do
         If (X+I>=1) And (X+I<=N) And (Y+I>=1) And (Y+I<=N) Then
            Inc(A[X+I,Y+I]);
     For I := -N To N Do
         If (X+I>=1) And (X+I<=N) And (Y-I>=1) And (Y-I<=N) Then
            Inc(A[X+I,Y-I]);
End;

Function CountArray:Integer;
Var I,J,S : Integer;
Begin
     S := 0;
     For I := 1 To N Do
         For J := 1 To N Do
             If A[I, J] = 0 Then Inc(S);
     CountArray := S;
End;

Begin

     ClearArray;
     ClearQueen;

     Q := 1;
     I := 1;

     While (Q <= M) Do
     Begin
          X := Trunc((I-1)/N)+1;
          Y := I-N*(X-1);
          If A[X,Y] = 0
          Then
            Begin
               SetArray(X,Y);
               K[Q].X := X;
               K[Q].Y := Y;
               Inc(Q);
            End
          Else Inc(I);

          If I > N*N
          Then
            Begin
                 Dec(Q);
                 I := 1+((K[Q].X - 1) * N + K[Q].Y);
                 K[Q].X := 0;
                 K[Q].Y := 0;

                 ClearArray;
                 For J := 1 To Q-1 Do SetArray(K[J].X,K[J].Y);
            End;

     End;


     ShowQueen;
     ClearArray;
     SetQueen;
     ShowArray;

     readln;
end.
Вот, нашел алгоритм. Проверил - работает. Если будут вопросы по нему - задавайте.

Последний раз редактировалось Xardas; 21.12.2011 в 00:13.
Xardas вне форума Ответить с цитированием
Старый 21.12.2011, 09:38   #3
Katrina*
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 29
Вопрос

Да эту программу я тоже нашла в интернете. но здесь выдаёт всю доску, а мне нужно чтобы я вводила размер доски 8х8, а ответ выходит только число 8(т.е. мах кол-во ферзей). Подскажите как сделать?

Последний раз редактировалось Katrina*; 21.12.2011 в 10:10.
Katrina* вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача про доску Katrina* Паскаль, Turbo Pascal, PascalABC.NET 5 20.12.2011 21:01
Задача про шахматную доску, Паскаль Locksmaster Помощь студентам 2 02.11.2011 12:45
Нарисовать 64х клетную шахматную доску viskas2011 Помощь студентам 2 08.04.2011 00:48
Задача про шахматную доску aiktz Помощь студентам 6 13.03.2009 11:53