Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 23.12.2011, 23:22   #1 (permalink)
Natali*
Новичок
 
Регистрация: 23.12.2011
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Unhappy Шахматная доска

Люди добрые подскажите пожалйста как решить задачу...

Задается шахматная доска NxM. Нужно вывести максимальное количество ферзей, которых можно расставить так, чтобы они не били друг друга.

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

Код:
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.
Natali* вне форума   Ответить с цитированием

Старый 23.12.2011, 23:22
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Я уверен, что проблема будет решаться гораздо быстрее если побольше узнать о ней

Выбор съёмного жёсткого доска
Шахматная доска

Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ


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

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




Часовой пояс GMT +4, время: 19:08.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.