Известно, что на доске 8×8 можно расставить 8 ферзей так, чтобы они не били друг друга. Вам дана расстановка 8 ферзей на доске, определите, есть ли среди них пара бьющих друг друга.
Программа получает на вход восемь пар чисел, каждое число от 1 до 8 — координаты 8 ферзей. Если ферзи не бьют друг друга, выведите слово NO, иначе выведите YES.
Другие языки программирования и технологии
Задача ферзей. Pascal abc
Ферзи с координатами x1,y1 и x2,y2 бьют друг друга, если истинно выражение:
((x1 - x2) * (y1 - y2) = 0) or (abs(x1 - x2) = abs(y1 - y2))
((x1 - x2) * (y1 - y2) = 0) or (abs(x1 - x2) = abs(y1 - y2))
Сделал веселую игрушку по мотивам вопроса))
Расставляет на случайные клетки ферзей и проверяет, бьют ли они друг друга.
Если ферзь никого не бьет - он беленький, иначе - красненький.
На левую кнопку мыши жмешь - генерирует случайный вариант расстановки.
На правую - перебирает случайные варианты пока не найдется такой, чтобы ферзи не били друг друга.
Сносное время ожидания при таком поиске: 5-6 ферзей..)
Сама программа:
program PascalABCdotNET;
uses GraphABC, Events;
const N = 5; // количество ферзей
var queen: array[1..8, 1..8] of boolean; // доска
var x, y: byte; // координаты для отрисовки
answer: boolean; // верное решение
procedure Reset(); {Очистка доски}
begin
for var i := 1 to 8 do
for var j := 1 to 8 do
queen[i,j] := false;
x := 0; y := 0;
end;
procedure Init(); {Расстановка ферзей на случайные клетки доски}
begin
x := Random(1, 8); y := Random(1, 8);
for var i := 1 to N do begin
while queen[x,y] do begin
x := Random(1, 8); y := Random(1, 8);
end;
queen[x,y] := true;
end;
end;
procedure Draw(); {Отрисовка доски с ферзями}
begin
for var i := 1 to 8 do
for var j := 1 to 8 do begin
if (odd(i) and odd(j)) or (not odd(i) and not odd(j)) then
SetBrushColor(RGB(150,90,60));
FillRectangle(50*i, 50*j, 50*(i+1), 50*(j+1));
if queen[i,j] then begin
SetBrushColor(clWhite);
Circle(50*i+25, 50*j+25, 20);
end;
SetBrushColor(RGB(200,200,10));
end;
end;
function Analize(): boolean; {Бьют ли ферзи друг друга}
begin
answer := true;
SetBrushColor(clRed);
for var i := 1 to 8 do begin
for var j := 1 to 8 do
if queen[i,j] then begin
for var m := 1 to 8 do
for var n := 1 to 8 do begin
if (i = m) and (j = n) then continue
else if queen[m,n] then
if ((i - m) * (j - n) = 0) or (abs(i - m) = abs(j - n)) then begin
Circle(50*i+25, 50*j+25, 20);
answer := false;
end;
end;
end;
end;
Result := answer;
end;
procedure Start(x, y, mb: integer); {Варианты работы программы}
begin
case mb of
1: begin // ЛКМ
Reset();
Init();
Draw();
Analize();
end;
2: begin // ПКМ
while not Analize() do begin
Reset();
Init();
Draw();
Analize();
end;
end;
end;
end;
begin
SetWindowSize(500, 500);
SetWindowTitle('Задача ферзей');
TextOut(160, 220, 'ЛКМ - следующий вариант'+#10+'ПКМ - поиск решения');
OnMouseDown := Start;
end.
Вот так выглядит:

Расставляет на случайные клетки ферзей и проверяет, бьют ли они друг друга.
Если ферзь никого не бьет - он беленький, иначе - красненький.
На левую кнопку мыши жмешь - генерирует случайный вариант расстановки.
На правую - перебирает случайные варианты пока не найдется такой, чтобы ферзи не били друг друга.
Сносное время ожидания при таком поиске: 5-6 ферзей..)
Сама программа:
program PascalABCdotNET;
uses GraphABC, Events;
const N = 5; // количество ферзей
var queen: array[1..8, 1..8] of boolean; // доска
var x, y: byte; // координаты для отрисовки
answer: boolean; // верное решение
procedure Reset(); {Очистка доски}
begin
for var i := 1 to 8 do
for var j := 1 to 8 do
queen[i,j] := false;
x := 0; y := 0;
end;
procedure Init(); {Расстановка ферзей на случайные клетки доски}
begin
x := Random(1, 8); y := Random(1, 8);
for var i := 1 to N do begin
while queen[x,y] do begin
x := Random(1, 8); y := Random(1, 8);
end;
queen[x,y] := true;
end;
end;
procedure Draw(); {Отрисовка доски с ферзями}
begin
for var i := 1 to 8 do
for var j := 1 to 8 do begin
if (odd(i) and odd(j)) or (not odd(i) and not odd(j)) then
SetBrushColor(RGB(150,90,60));
FillRectangle(50*i, 50*j, 50*(i+1), 50*(j+1));
if queen[i,j] then begin
SetBrushColor(clWhite);
Circle(50*i+25, 50*j+25, 20);
end;
SetBrushColor(RGB(200,200,10));
end;
end;
function Analize(): boolean; {Бьют ли ферзи друг друга}
begin
answer := true;
SetBrushColor(clRed);
for var i := 1 to 8 do begin
for var j := 1 to 8 do
if queen[i,j] then begin
for var m := 1 to 8 do
for var n := 1 to 8 do begin
if (i = m) and (j = n) then continue
else if queen[m,n] then
if ((i - m) * (j - n) = 0) or (abs(i - m) = abs(j - n)) then begin
Circle(50*i+25, 50*j+25, 20);
answer := false;
end;
end;
end;
end;
Result := answer;
end;
procedure Start(x, y, mb: integer); {Варианты работы программы}
begin
case mb of
1: begin // ЛКМ
Reset();
Init();
Draw();
Analize();
end;
2: begin // ПКМ
while not Analize() do begin
Reset();
Init();
Draw();
Analize();
end;
end;
end;
end;
begin
SetWindowSize(500, 500);
SetWindowTitle('Задача ферзей');
TextOut(160, 220, 'ЛКМ - следующий вариант'+#10+'ПКМ - поиск решения');
OnMouseDown := Start;
end.
Вот так выглядит:

Похожие вопросы
- помогите с задачей по Pascal abc!!!
- Помогите пожалуйста решить задачу в Pascal ABC
- Помогите написать простые программы и задачи в Pascal ABC. Алгоритмы ветвления. Информатика. Програмирование.
- Помогите с составлением задач в Pascal ABC!!Срочно!
- Напишите программу к задаче в Pascal abc. Необходимо ввести три целых числа и определить, какое из них
- Помогите с задачей на Pascal ABC
- Проблема с программой в Pascal ABC,Встречено ';',а ожидалось ':'. Если менять, то вылетает ещё ошибка с if
- Программа в pascal abc
- Задача Pascal ABC: Точечный удар
- Помогите решить задачу по информатике 9 класс. Pascal ABC