надо расставить ферзей столько сколько можно, у меня чего то не получается поиск Опции

[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 мин.
чегото я запутался в проверке по диагоналям

Сообщение отредактировано: maksimla - 29.12.2009 17:45

[sheka]

Если надо конкретный случай, для доски 8*8, то это можно сделать 8ю циклами. там ответ 92 получается.

Сообщение отредактировано: sheka - 29.12.2009 19:43

[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]

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

Количество различных вариантов расположения ферзей на доске.

Сообщение отредактировано: sheka - 30.12.2009 20:34