VPF::Кратчайший путь передвижения коня по заданному кле

Otclik

Дата 22.12.2015, 09:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 22.12.2015

Репутация: нет
Всего: нет

Есть программа находящая кратчайший путь передвижения коня по заданному клеточному полю, соединяющих два заданных поля доски.
Прошу помогите разобраться с алгоритмом этой программы. Очень хочу разобраться.
Также что делают:
- Procedure Push
- function Pop
- function TryXY
- procedure Hod

Автор программы пишет(аж в 2006):
----(сначала пробовал рекурсивно (находит далеко не оптимально)
потом сделал с помощью динамической памяти.
точнее, используется очередь: кандидат вставляется в конец очереди,
обрабатывается 'первый')----

Объясните что это зачнет!
Знаю что есть различные алгоритмы, но какой здесь?
Очень хочу разобраться

Код:

Код


unit Kon;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids;

type
  TForm1 = class(TForm)
    Sg: TStringGrid;
    BitBtn1: TBitBtn;
    procedure SgDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SgMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

Type
  Pzap = ^Tzap;
  Tzap = record
           x, y, n: integer;
           pz, nz: Pzap;
         end;

Var
  k: Tpoint = (X:4; Y:2);
  p: Tpoint = (X:2; Y:2);
  aa: array[1..9, 1..9] of byte;

  a1, a2: array[1..64] of Tpoint;
  z, z0: Pzap;

procedure Clear(); 
var
  i, j: integer;
begin
  for i:=-1 to 10 do
    for j:=-1 to 10 do
      if (i<1)or(j<1)or(i>8)or(j>8)
        then aa[i, j]:= 1
        else aa[i, j]:= 0;
end;

procedure Push(x,y,a: integer);
var w: Pzap;
begin
  if (aa[x, y]>0) then exit;
  aa[x, y]:= 1;

  New(w);
  w.x:= x;
  w.y:= y;
  w.n:= a;

  z0.pz:= w;
  w.nz:= z;
  w.pz:= nil;
  z0:= w;
end;

function Pop(var x,y,a: integer): boolean;

begin
  Result:= false;
  
  if z=nil then exit;

 
  z:= z.pz;

  x:= z.x;
  y:= z.y;
  a:= z.n;
  Result:= true;
end;

function Get(x,y: integer): integer;

function TryXY(x,y, a: integer): boolean;
begin
  Result:= (x=p.X)and(y=p.Y);
  if not Result then Push(x, y, a);
end;

var
  n: integer;
  Res: boolean;

begin
  Result:= -1;
  n:= 0;
  new(z0);
  z0.x:= x;
  z0.y:= y;
  z0.n:= 0;
  z0.pz:= nil;
  z0.nz:= nil;
  z:= z0;

  aa[x, y]:= 3;

  Repeat
    inc(n);
    Res:= TryXY(x-1, y-2, n) or
    TryXY(x-1, y+2, n) or
    TryXY(x+1, y-2, n) or
    TryXY(x+1, y+2, n) or
    TryXY(x+2, y+1, n) or
    TryXY(x+2, y-1, n) or
    TryXY(x-2, y+1, n) or
    TryXY(x-2, y-1, n);

    if Res then
    begin
      Result:= n;
      aa[p.x, p.y]:= 4;
      while z<> nil do
      begin
        aa[z.x, z.y]:= 2;
        z:= z.nz;
      end;
      break;
    end;
    if not pop(x,y,n) then break;

  Until z0=nil;

end;

procedure Hod(x,y: integer; a: integer; var r: integer);
begin
  if aa[x, y]>0 then exit;
  if (R>=0)and(a>=R) then
  begin
    aa[x, y]:= 1;
    exit;
  end;

  if (x=p.X)and(y=p.Y) then
  begin
    {if (a<R)or(R<0) then} R:= a;
    aa[x, y]:= 1;
    exit;
  end;

  aa[x, y]:= 1;
  inc(a);
  Hod(x-1, y-2, a, r);
  Hod(x-2, y-1, a, r);
  Hod(x-1, y+2, a, r);
  Hod(x-2, y+1, a, r);
  Hod(x+1, y+2, a, r);
  Hod(x+2, y+1, a, r);
  Hod(x+1, y-2, a, r);
  Hod(x+2, y-1, a, r);
end;



procedure TForm1.SgDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var st: string;
begin
  if (aCol+aRow)=0 then exit;
  st:= '';

  with sg.Canvas do
  begin
    Case aa[aCol, aRow] of
      1: brush.Color:= clMedGray;
      0: brush.Color:= clWhite;
      2: brush.Color:= clNavy;
      else brush.Color:= clBlack;
    end;

    if acol=0 then st:= inttostr(arow) else
    if arow=0 then st:= inttostr(acol) else
    if (acol=k.X)and(arow=k.Y) then
    begin
      st:= 'Ê';
      brush.Color:= clYellow;
    end
      else
    if (acol=p.X)and(arow=p.Y) then
    begin
      st:= '*';
      brush.Color:= clYellow;
    end;
    Rectangle(Rect);
    Font.Color:= clBlack;
    TextOut(rect.Left+7, rect.Top+5, st);
  end;
end;

procedure TForm1.SgMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r, c: integer;
begin
  sg.MouseToCell(x,y, c,r);

  if (c*r=0) then exit;
  if Button= mbLeft then
  begin
    k.X:= c;
    k.Y:= r;
  end
  else
  begin
    p.X:= c;
    p.Y:= r;
  end;
  
  Clear();
  sg.Refresh;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var r: integer;
begin
  Caption:= '';
  r:= -1;
  
  Clear();
  r:= Get(k.X, k.Y);
  
  Caption:= IntToStr(r);

  sg.Refresh;
end;

end.

Это сообщение отредактировал(а) Otclik - 22.12.2015, 10:52

Angel666

Дата 23.12.2015, 10:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 0
Регистрация: 8.9.2011

Репутация: нет
Всего: 1

Вот тут тема была про этого коня и клетки
http://ru.vingrad.com/Perevod-programmnogo...e2015910e8b4567

Этот ответ добавлен с нового Винграда - http://vingrad.com

ФедосеевПавел

Дата 24.12.2015, 22:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 291
Регистрация: 7.2.2009

Репутация: 1
Всего: 10

Это модификация волнового алгоритма (алгоритма Ли) выхода из лабиринта. Вся модификация заключается в способе перемещения не на соседние клетки, а "конским прыжком". Описание алгоритма в Википедии.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »