Песни о Паскале

Деревенец Олег Виленович

procedure Expand(arg : PNode);

Она расширяет империю, начиная с заданного параметром arg узла. Алгоритм процедуры отвечает рассуждениям Ника, рассмотрим её подробней.

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

Далее следует цикл WHILE, он выполняется,

пока очередь желающих войти в империю не опустеет. Выбрав из очереди функцией GetFromQue первый узел (в этот момент очередь опустеет, но ненадолго), пробегаем по списку его белых соседей, располагая там нужную информацию, перекрашивая соседей в серый цвет и помещая их в очередь. После этого извлеченный из очереди узел P очерняем и возвращаемся к началу цикла WHILE. Поскольку очередь узлов уже не пуста (добавились соседние узлы), функция GetFromQue выберет из неё следующий узел, и цикл WHILE выполнится вновь. В конце концов белые узлы когда-то иссякнут. Тогда пополнение очереди прекратится, серые узлы постепенно будут выбраны из неё, очередь опустеет, и цикл WHILE завершится.

Вот, собственно и все. Для наблюдения за экспансией империи в процедуру вставлены операторы печати, не влияющие на её работу (они выделены).

{ P_58_1 – Обход графа в ширину }

type PNode = ^TNode; { Указатель на запись-узел }

PLink = ^TLink; { Указатель на список связей }

TColor = (White, Gray, Black); { Перечисление для цветов узла }

TLink = record { Список связей }

mLink : PNode; { указатель на смежный узел }

mNext : PLink; { указатель на следующую запись в списке }

end;

TNode = record { Запись для хранения страны (узел графа) }

mName : Char; { Название страны (одна буква) }

mColor: TColor; { цвет узла, изначально белый }

mDist : integer; { длина пути к узлу, изначально -1 }

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

mLinks: PLink; { список смежных узлов (указатели на соседей ) }

mNext : PNode; { указатель на следующую запись в списке }

end;

var List : PNode; { список всех стран континента }

Que : PLink; { очередь присоединяемых узлов }

{ Функция поиска страны (узла графа) по имени страны }

function GetPtr(aName : char): PNode;

{ Взять из P_57_1 }

end;

{ Функция создает новую страну (узел) }

function MakeNode(aName : Char): PNode;

{ Взять из P_57_1 }

end;

{ Процедура установки связи узла p1 с узлом p2 }

procedure Link(p1, p2 : PNode);

{ Взять из P_57_1 }

end;

{ Процедура чтения графа из текстового файла.}

procedure ReadData(var F: Text);

{

Взять из P_57_1 }

end;

{ Помещение указателя на узел в глобальную очередь Que }

procedure PutInQue(arg: PNode);

var p: PLink;

begin

New(p); { создаем новую переменную-связь }

p^.mLink:= arg; { размещаем указатель на узел }

{ размещаем указатель в голове очереди }

p^.mNext:= Que; { указатель на предыдущую запись }

Que:=p; { текущая запись в голове очереди }

end;

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

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; { начинаем с головы списка узлов }