Шахматная доска
Люди добрые подскажите пожалйста как решить задачу...
Задается шахматная доска NxM. Нужно вывести максимальное количество ферзей, которых можно расставить так, чтобы они не били друг друга.
Вот есть программа, но здесь после компиляции выдаёт всю доску, а мне нужно чтобы я вводила размер доски 8х8 и ответ выходил только число 8(т.е. мах кол-во ферзей). Подскажите как сделать? И организовать это все через файлы.... :tehnari_ru_1019:
Люди добрые подскажите пожалйста как решить задачу...
Задается шахматная доска NxM. Нужно вывести максимальное количество ферзей, которых можно расставить так, чтобы они не били друг друга.
Вот есть программа, но здесь после компиляции выдаёт всю доску, а мне нужно чтобы я вводила размер доски 8х8 и ответ выходил только число 8(т.е. мах кол-во ферзей). Подскажите как сделать? И организовать это все через файлы.... :tehnari_ru_1019:
Код:
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.