Найдите способ переставить коней в заданные клетки за наименьшее количество ходов

@msk19 · Регистрация: 16.11.2015

Author24 — интернет-сервис помощи студентам

На шахматной доске стоят два коня, также заданы две клетки, в которые необходимо переставить этих коней. Найдите способ переставить коней в заданные клетки за наименьшее количество ходов. Кони ходят по шахматным правилам, порядок ходов не важен, конь не может становиться на клетку, если она занята другим конем

Решил сначала сделать для 1 коня и без нахождения наименьшего кол-ва ходов

Pascal

program h;
var a:array[1..8,1..8] of integer=((0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0));
 u,q,y1,x1,x:integer;
 
procedure kn(y,x:integer);
begin
 
if q=5 then exit;
if a[y,x]=2 then begin q:=5;exit end;
 if (a[y,x]<>1)  then a[y,x]:=1
  else begin
  a[y,x]:=0; exit
        end;
 
if (y<8) and (x<7) then kn(y+1,x+2);
if (y>1) and (x<7) then kn(y-1,x+2);
if (y<7) and (x<8) then kn(y+2,x+1);
if (y<7) and (x>1) then kn(y+2,x-1);
if (y<8) and (x>2) then kn(y+1,x-2);
if (y>1) and (x>2) then kn(y-1,x-2);
if (y>2) and (x<8) then kn(y-2,x+1);
if (y>2) and (x>1) then kn(y-2,x-1);
 
end;
begin
 y1:=7;
 x1:=3;
a[y1,x1]:=3;
a[2,7]:=2;
kn(7,3);
 q:=1;
 a[y1,x1]:=3;
 for u:=1 to 8 do begin
 writeln;
 for x:=1 to 8 do
 write(a[u,x],' ');
    end;
readln
end.

Но происходит переполнение стека ,как можно исправить ?

Добавлено через 23 минуты
Переполнение исправил.В итоге получается кроме самих точек "дороги" в конечную точку есть точки которые к ней не относятся ,какое условие добавить что бы они не печатались ?

ФедосеевПавел · 21.01.2016, 20:49

А можно увидеть детализацию вопроса? Да и исправленную программу?

Добавлено через 3 минуты
Да и почему не реализуете BFS=волновой алгоритм с модификацией другого перемещения?

@msk19 · 21.01.2016, 23:37 **[ТС]**

Pascal

var a:array[1..8,1..8] of integer=((0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0),
                                   (0,0,0,0,0,0,0,0));
 u,q,y1,x1,x:integer;
 
procedure kn(y,x:integer);
begin
 
if q=5 then exit;
if a[y,x]=2 then begin q:=5;exit end;
 if (a[y,x]<>1)  then a[y,x]:=1
  else begin
  a[y,x]:=0; exit
        end;
 
if (y<8) and (x<7) then kn(y+1,x+2);
if (y>1) and (x<7) then kn(y-1,x+2);
if (y<7) and (x<8) then kn(y+2,x+1);
if (y<7) and (x>1) then kn(y+2,x-1);
if (y<8) and (x>2) then kn(y+1,x-2);
if (y>1) and (x>2) then kn(y-1,x-2);
if (y>2) and (x<8) then kn(y-2,x+1);
if (y>2) and (x>1) then kn(y-2,x-1);
 
end;
begin
 y1:=7;
 x1:=3;
a[y1,x1]:=3;
a[2,7]:=2;
kn(7,3);
 q:=1;
 a[y1,x1]:=3;
 for u:=1 to 8 do begin
 writeln;
 for x:=1 to 8 do
 write(a[u,x],' ');
    end;
readln
end.

Добавлено через 33 секунды

Сообщение от ФедосеевПавел

Да и почему не реализуете BFS=волновой алгоритм с модификацией другого перемещения?

Хочу с рекурсией потренероваться

ФедосеевПавел · 22.01.2016, 20:57

Коряво-коряво:

Pascal

program Test;
 
const
  Dx: array[1..8] of integer = (1, 2, 2, 1, -1, -2, -2, -1);
  Dy: array[1..8] of integer = (2, 1, -1, -2, -2, -1, 1, 2);
var
  a: array[1..8, 1..8] of integer = 
   ((0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0, 0));
var
  Xfin, Yfin: integer;
 
  function kn(y, x, Depth: integer): boolean;
  var
    i, j: integer;
  begin
    if (x < 1) or (x > 8) or (y < 1) or (y > 8) then
    begin
      kn := False;
      exit;
    end;
    if a[y, x] <> 0 then
    begin
      kn := False;
      exit;
    end;
    if (x = Xfin) and (y = Yfin) then
    begin
      for i := 1 to 8 do
        for j := 1 to 8 do
          a[i, j] := 0;
      a[Yfin, Xfin] := Depth;
      kn := True;
      exit;
    end;
    a[y, x] := Depth;
    for i := 1 to 8 do
    begin
      kn := kn(y + Dy[i], x + Dx[i], Depth + 1);
      if kn then
      begin
        a[y, x] := Depth;
        break;
      end;
    end;
  end;
 
var
  Xstart, Ystart: integer;
  i, j: integer;
begin
  Xstart := 2;
  Ystart := 7;
  Xfin := 7;
  Yfin := 3;
  kn(Ystart, Xstart, 1);
  for i := 1 to 8 do
  begin
    for j := 1 to 8 do
      Write(a[i, j]: 3);
    writeln;
  end;
  writeln;
end.

Решительно рекомендую изучить алгоритм Ли (волновой) и пользоваться им. Там кода больше (за счёт реализации структур "очередь" и "стек"), но решение красивее и эффективнее.

ФедосеевПавел Модератор 8476 / 4335 / 1642 Регистрация: 01.02.2015 Сообщений: 13,461 Записей в блоге: 8
	21.01.2016, 20:49	2
	А можно увидеть детализацию вопроса? Да и исправленную программу? Добавлено через 3 минуты Да и почему не реализуете BFS=волновой алгоритм с модификацией другого перемещения? 0

	22.01.2016, 20:57