Чтение онлайн

ЖАНРЫ

Шрифт:

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

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

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

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 { если такая страна существует, }

Поделиться с друзьями: