23.12.2011, 23:22 | #1 (permalink) |
Новичок
Регистрация: 23.12.2011
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Шахматная доска
Задается шахматная доска 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. |
23.12.2011, 23:22 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Я уверен, что проблема будет решаться гораздо быстрее если побольше узнать о ней Выбор съёмного жёсткого доска Шахматная доска |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|