Помощь - Поиск - Пользователи - Календарь
Полная версия: надо расставить ферзей столько сколько можно
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
maksimla
Задание Можно ли на доске расставить 8 ферзей чтобы они друг друга не били - тесть две фигуры не стояли на вертикальной,горизонтальной и на диагонали.
Вам надо докончить программу ферзи вместо комментариев без скобок написать нужные действия.
Замечание надо чтобы только там писать где скобок нету в комментариях.
Дополнение если кому не буть нужны дополнительные переменные то может это сделать но написать коментария надо будет зачем они .
вот сама программка
program valdovės;
const n = 8;
type lenta = array [1..n, 1..n] of boolean;
var len: lenta;
jau: boolean;

function galima (len: lenta; x, y: integer): boolean;
begin
тут надо проверить можно ли на клеточке (x, y) ставить ферзя тоесть чтобы не один
другой ферзь не стояли на вертикальной,горизонтальной и на диагонали.
end;

procedure statyti (var len: lenta; { доска шахмат с отмечеными ферзями }
x: integer; { x-тая доски строчка }
var jau: boolean); { поставлен последний ферьзь }
var y: integer; {y-тая столбик}
begin
y := 0;
repeat
y := y + 1;
if galima (len, x, y) then
begin
len[x, y] := true;
if x = n
then jau = true { поставлен последний ферьзь }
else begin
if not jau then { если не все ферьзи поставлены }
рекурсионное обращение в процедуру statyti
end
end
until jau or (y = n)
end;

procedure spausdinti (len: lenta);
begin
печатаем всю доску (массив len) с ферзями на доске ферзи будут обозначатся буквой v а пустота знаком +
end;

begin {ферьзь}
масив len заполните значениеми весь false
jau := false;
statyti (len, 1, jau);
spausdinti (len)
end.



у меня в функции galima ошибка как я думаю
program valdoves;
const n = 8;
type lenta = array [1..n, 1..n ] of boolean;
var len: lenta;
jau: boolean;
var i,j:integer;
function galima (len: lenta; x, y: integer): boolean;
var z,x1,y1:integer;
begin

z:=0;
x1:=x;
y1:=y;
for i:=1 to n do
if len[x1,i]=true then inc(z);
for i:=1 to n do
if len[i,y1]= false then inc(z);
for i:=x1 to n do
for j:=y1 to n do
if len[i,j]=true then inc(z);
while (x1<>1) and (y1<>1) do
begin
dec(x1);
dec(y1);
if len[x1,y1]=true then inc(z);
end;
while (y1<>1) and (x1<>8) do
begin
inc(x1);
dec(y1);
if len[x1,y1]=true then inc(z);
end;
if z=0 then len[x,y]:=true;

end;
procedure statyti (var len: lenta; x: integer; var jau: boolean);
var y: integer;
begin
y := 0;
repeat
y := y + 1;
if galima (len, x, y) then
begin
len [x, y] := true;
if x = n
then jau:= true
else begin
if not jau then statyti(len,x+1,jau)
end
end
until jau or (y = n)
end;
procedure spausdinti (len: lenta);
begin
for i:=1 to n do
begin
for j:=1 to n do
if len[i,j] then write('+')
else write('v');
writeln;
end;
end;
begin
for i:=1 to n do
for j:=1 to n do
len[i,j]:= false;
jau := false;
statyti (len, 1, jau);
spausdinti (len);
readln
end.




Добавлено через 1 мин.
чегото я запутался в проверке по диагоналям
sheka
Если надо конкретный случай, для доски 8*8, то это можно сделать 8ю циклами. там ответ 92 получается.
maksimla
что за 92 ответ ?

Добавлено через 2 мин.
что получится 92 ?
у меня просто поиск плохо работает немогу исправить покачто

Добавлено через 1 мин.
вот одну ошибку свою смешную исправил вот програмка
program valdoves;
const n = 8;
type lenta = array [1..n, 1..n ] of boolean;
var len: lenta;
jau: boolean;
var i,j:integer;
function galima (len: lenta; x, y: integer): boolean;
var z,x1,y1:integer;
begin
z:=0;
x1:=x;
y1:=y;
for i:=1 to n do
if len[x1,i]=true then inc(z);
for i:=1 to n do
if len[i,y1]= true then inc(z);
for i:=x1 to n do
for j:=y1 to n do
if len[i,j]=true then inc(z);
for i:=x1 downto 1 do
for j:=y1 downto n do
if len[i,j]=true then inc(z);
if z=0 then galima:=true;


end;
procedure statyti (var len: lenta; x: integer; var jau: boolean);
var y: integer;
begin
y := 0;
repeat
y := y + 1;
if galima (len, x, y) then
begin
len [x, y] := true;
if x = n
then jau:= true
else begin
if not jau then statyti(len,x+1,jau)
end
end
until jau or (y = n)
end;
procedure spausdinti (len: lenta);
begin
for i:=1 to n do
begin
for j:=1 to n do
if len[i,j] then write('v')
else write('+');
writeln;
end;
end;
begin
for i:=1 to n do
for j:=1 to n do
len[i,j]:= false;
jau := false;
statyti (len, 1, jau);
spausdinti (len);
readln
end.


но серовно поиск неработает на какую можно ферзя ставить
Lapp
Задача о ферзях рассмотрена в нашем FAQ (спасибо virt'у): Переборные Алгоритмы
maksimla
все кажется получилось вот
program valdoves;
const n = 8;
type lenta = array [1..n, 1..n ] of boolean;
var len: lenta;
jau: boolean;
i,j:integer;
function galima (len: lenta; x, y: integer): boolean;
begin
galima := true;
for i := 1 to n do
begin
if (len[x,i] = true)
or (len[i,y] = true)
or ((x-i > 0) and (y+i < 9) and (len[x-i,y+i] = true))
or ((x+i < 9) and (y-i > 0) and (len[x+i,y-i] = true))
or ((x+i < 9) and (y+i < 9) and (len[x+i,y+i] = true))
or ((x-i > 0) and (y-i > 0) and (len[x-i,y-i] = true))
then galima := false;
end;
end;
procedure statyti (var len: lenta; x: integer; var jau: boolean);
var y: integer;
begin
y := 0;
repeat
y := y + 1;
if galima (len, x, y) then
begin
len [x, y] := true;
if x = n
then jau:= true
else begin
if not jau then statyti(len,x+1,jau)
end
end
until jau or (y = n)
end;
procedure spausdinti (len: lenta);
begin
for i:=1 to n do
begin
for j:=1 to n do
if len[i,j] then write('v')
else write('+');
writeln;
end;
end;
begin
for i:=1 to n do
for j:=1 to n do
len[i,j]:= false;
jau := false;
statyti (len, 1, jau);
spausdinti (len);
readln
end.
sheka
Цитата(maksimla @ 29.12.2009 18:46) *

что за 92 ответ ?

Количество различных вариантов расположения ферзей на доске.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.