Олег Деревенец - Песни о Паскале

{ Извлечение из очереди указателя на узел }

function GetFromQue(var arg: Pnode): boolean;

var p, q: PLink;

begin

GetFromQue:= Assigned(Que);

if Assigned(Que) then begin

{ Поиск последнего элемента (хвоста) очереди }

p:= Que; q:=p;

{ если в очереди только один элемент, цикл не выполнится ни разу! }

while Assigned(p^.mNext) do begin

q:=p; { текущий }

p:=p^.mNext; { следующий }

end;

{ p и q указывают на последний и предпоследний элементы }

arg:= p^.mLink;

if p=q { если в очереди был один элемент… }

then Que:= nil { очередь стала пустой }

else q^.mNext:= nil; { а иначе "отцепляем" последний элемент }

Dispose(p); { освобождаем память последнего элемента }

end;

end;

{ Процедура расширения (экспансии) "империи", начиная с заданного узла arg }

procedure Expand(arg : PNode);

var p : PNode;

q : PLink;

begin

arg^.mDist:= 0; { расстояние до центра империи = 0 }

arg^.mColor:= Gray; { метим серым цветом }

PutInQue(arg); { и помещаем в очередь обработки }

while GetFromQue(p) do begin { извлекаем очередной узел }

Write(p^.mName, ' ->') ; { печатаем название узла – для отладки }

q:= p^.mLinks; { начинаем просмотр соседей }

while Assigned(q) do begin

if q^.mLink^.mColor = White then begin { если сосед ещё белый }

q^.mLink^.mColor:= Gray; { метим его серым }

q^.mLink^.mDist:= p^.mDist +1; { расстояние до центра }

q^.mLink^.mPrev:= p; { метим, откуда пришли }

PutInQue(q^.mLink); { и помещаем в очередь обработки }

Write(q^.mLink^.mName:2) ; { имя соседа – это для отладки }

end;

q:= q^.mNext; { переход к следующему соседу }

end;

p^.mColor:= Black; { после обработки узла метим его черным }

Writeln ; { новая строка – это для отладки }

end;

end;

{ Инициализация списка узлов перед "постройкой империи" }

procedure InitList;

var p : PNode;

begin

p:= List; { начинаем с головы списка узлов }

{ проходим по всем элементам списка }

while Assigned(p) do begin

p^.mColor:= White; { цвет узла изначально белый }

p^.mDist := -1; { длина пути к узлу изначально -1 }

p^.mPrev := nil; { узел, из которого пришли в данный }

p:= p^.mNext; { следующий узел }

end;

end;

var F_In {, F_Out} : Text; { входной и выходной файла }

C : Char; { название страны }

Start : PNode; { узел, с которого начинается расширение "империи" }

begin {--- Главная программа ---}

{ Инициализация списка узлов и очереди узлов }

List:= nil; Que:= nil;

Assign(F_In, 'P_57_1.in');

ReadData(F_In); { чтение графа }

{ Цикл ввода названий стран }

repeat

Write('Центр империи = '); Readln(C);

C:= UpCase(C);

if not (C in ['A'..'Z']) then break;

Start:= GetPtr(C); { указатель на центр империи }

if Assigned(Start) then begin { если такая страна существует, }

InitList; { устанавливаем начальные значения в полях узлов }

Expand(Start); { расширяем "империю" от центра Start }

end;

until false

end.

В главной программе организован цикл, принимающий от пользователя исходную страну, из которой строится империя. Программа завершается при вводе любого символа, отличного от латинской буквы. Запустив программу, я ввел символ «E» и увидел на экране вот что.

E -> F D

F -> G A

D -> C

G -> I H

A -> B

C ->

I ->

H ->

B –>

Эти строки напечатаны операторами трассировки в процедуре Expand. Согласно первой строке из узла «E» мы попадаем в узлы «F» и «D». Согласно второй – из узла «F» движемся в узлы «G» и «A», и так далее. Последние четыре строки показывают, что узлы «C», «I», «H» и «B» оказались на окраинах империи, и продвижений оттуда нет. По этой трассировке нетрудно нарисовать дерево воображаемого продвижения купцов (рис. 145).

Сопоставьте это дерево с тем, что нацарапал на песке придворный программист (рис. 144). Разницы не заметит только слепой. В чем дело? Неужели вкралась ошибка?

Но, прежде чем огорчаться, сравните расстояния между центром империи и другими узлами – на обоих рисунках они совпадают. А это значит, что можно найти разные варианты кратчайших путей. Какой из них выберет программа – дело случая. Точнее, это определяется порядком ввода узлов. Мы знаем, что порядок строк входного файла не влияет на форму графа, но он влияет на выбор одного из кратчайших путей между узлами. Правда, купцам до этого дела нет, – ведь расстояния по таким путям будут одинаковыми.

Теперь все готово для создания полной версии программы. Пройдясь по графу вширь, мы разместили в узлах необходимые данные: расстояния от корня и обратные ссылки на пройденные узлы. Пора ставить победную точку – напечатать кратчайший путь между двумя узлами и длину этого пути.

Для постройки кратчайшего пути надо указать узел, из которого мы хотим попасть в центр империи. Двигаясь из него по цепочке обратных ссылок в направлении центра, мы, в конце концов, попадем в него. Значение обратной ссылки в центре империи равно NIL, что будет признаком окончания пути. С этой работой справится несложная функция MakePath – «создать путь».

function MakePath(arg : PNode): string;

В функцию передается узел, от которого надо вернуться к корню дерева, то есть к центру империи. Результатом будет строка пути вида «A –> B –> C».

Главную программу слегка дополним. Теперь пользователь введет названия двух стран, между которыми ищется кратчайший путь: «откуда» и «куда». Страну «откуда» назначим центром империи, а из страны «куда» будем возвращаться по цепочке обратных ссылок, – она составит параметр функции MakePath. Поскольку вводятся названия стран, а не указатели на них, преобразование имен в указатели тоже сделаем в главной программе.

Итак, в главной программе выполняются:

• ввод графа из текстового файла;

• ввод имен двух стран и преобразование их в указатели;

• подготовка узлов графа – заполнение полей начальными значениями;

• обход графа в ширину из заданного корня;

• распечатка кратчайшего пути по цепочке обратных ссылок.