Олимпиадные задачи по программированию. Ч. 4. Лучшие решения. Ускова О.Ф - 62 стр.

UptoLike

Составители: 

procedure Test(p1 : proom); {Если нужно, то ставим метку}
begin
if ((p1 <> nil) and ((p1^.lab > lab+1) or (p1^.lab = -1))) then begin
p1^.lab := lab+1;
pQ^.Push(p1, lab+1);
end;
end;
begin
if pEnd = nil then exit;
new(pQ); pQ^.Create; {нерекурсивный метод расстановк меток}
pQ^.Push(pEnd, 0); pEnd^.lab := 0;
while (not pQ^.Empty) do begin
pQ^.Pop(pnt, lab); p := pnt;
Test(p^.pN); Test(p^.pE);
Test(p^.pS); Test(p^.pW);
end;
pQ^.Destroy; dispose(pQ);
end;
procedure GetPath(var f2 : text); {запись кратчайшего пути в файл}
var pCur : proom;
function IsPath(p : proom) : boolean; {правильный ли путь}
begin
IsPath := ((p <> nil) and (p^.lab = pCur^.lab-1));
end;
begin
if pFirst = nil then exit;
pCur := pFirst;
while (pCur^.lab <> 0) do begin
if IsPath(pCur^.pN) then begin
write(f2, 'N'); pCur := pCur^.pN;
end else if IsPath(pCur^.pE) then begin
write(f2, 'E'); pCur := pCur^.pE;
end else if IsPath(pCur^.pS) then begin
write(f2, 'S'); pCur := pCur^.pS;
end else if IsPath(pCur^.pW) then begin
write(f2, 'W'); pCur := pCur^.pW;
end;