Лабиринт

[Claster]

Ребята помогите плиииззз написать: рекурсивный поиск от цели в ширину;
А то препад задал нифига не обьяснил(только то какие они бывают и всё)

Дабраться из точки А в точку В, с помощью рекурсивного поиска от А в ширину до точки В, с возможностю ставить самому точку А и точку В

[Jean-Esther]

Реализация на Паскале.
Основа: процедура Solve. Требуется массив a, где true — наличие преграды, и четыре целых числа S 1-2 x-y — координаты двух точек, между которыми мы ищем путь. Результат: массив path.

program lab;
uses Crt;
const max=3;
type range=1..max;
type TPoint=record x,y:range end;
var a:array[range,range] of boolean;
var n,S1x,S1y,S2x,S2y:range;
var path:array[1..max*max] of TPoint;
var steps:integer;
procedure Reading(filename:string);
          var F:Text; i,j:range; m:array[range,range]of byte absolute a;
          begin
               writeln('loading...');
               Assign(F,filename);
               Reset(F);
               readln(F,n);
               for i:=1 to n do
                 for j:=1 to n do
                   read(F,m[i,j]);
               read(F,S1x,S1y,S2x,S2y);
               Close(F);
               writeln('wait a moment...');
          end;
procedure Solve;
          var p:array[1..max*max] of TPoint;
          var m:array[range,range] of boolean; {marks}
          var head,tail:1..max*max;
          var EHBF:boolean; {Exit Has Been Found}
          var Cur:TPoint;
          procedure Add(x,y:range);
                    begin
                         if not m[x,y]
                            then begin
                                 m[x,y]:=true;
                                 inc(head);
                                 p[head].x:=x;
                                 p[head].y:=y;
                            end;
                         if (x=S2x) and (y=S2y) then EHBF:=true;
                    end;
          function Assigned(P1,P2:TPoint):boolean;
                    begin
                         Assigned:=(abs(P1.x-P2.x)=1) or (abs(P1.y-P2.y)=1);
                    end;
          procedure AddPart(po:tpoint);
                    begin
                         inc(steps);
                         path[steps]:=po;
                    end;
          begin
               fillchar(p,sizeof(p),0);
               steps:=0;
               head:=1;
               tail:=1;
               p[1].x:=S1x;
               p[1].y:=S1y;
               EHBF:=false;
               fillchar(m,sizeof(m),false);
               Repeat
                     Cur:=p[tail];
                     if (Cur.x<n) and not a[Cur.x+1,Cur.y] then Add(cur.x+1,cur.y);
                     if (Cur.y<n) and not a[Cur.x,Cur.y+1] then Add(cur.x,cur.y+1);
                     if (Cur.x>1) and not a[Cur.x-1,Cur.y] then Add(cur.x-1,cur.y);
                     if (Cur.y>1) and not a[Cur.x,Cur.y-1] then Add(cur.x,cur.y-1);
                     inc(tail);
               Until (tail>head) or EHBF;
               {searching for the path}
               if EHBF
                  then begin
                       while (p[head].x<>S2x) and (p[head].y<>S2y) do dec(head);
                       Cur:=p[head]; {=S2;}
                       AddPart(Cur);
                       while head>1 do
                             begin
                                  tail:=head;
                                  repeat
                                        if tail>1 then
                                           begin
                                                dec(tail);
                                                EHBF:=Assigned(p[head],p[tail]);
                                                if EHBF then AddPart(p[tail]);
                                           end;
                                  until EHBF or (tail=1);
                                  head:=tail;
                             end;
                  end;
          end;
procedure WritePath;
          var i:integer;
          begin
               for i:=1 to steps do
                   writeln(path[i].x,' ',path[i].y);
               readln;
          end;
begin
clrscr;
Reading('lab.txt');
Solve;
WritePath;
end.