Program Graph;
{ создание и распечатка графа }
Uses Crt;
Type
ukaz=^uzel;
point=^duga;
uzel=record { список вершин графа }
Nom: integer;
Next: ukaz;
Sv: point
end;
duga=record { структура дуги графа }
Next: point;
Sv: ukaz
end;
Var
A, B: integer;
L: boolean;
Top, Kon, Ua, Ub: ukaz;
P, Q: point;
Ch: char;
Begin
L:=True; Top:=Nil;
While L do
Begin
Write('Введите связи в виде пары вершин (-1 -конец) ');
Read(A);
if A=-1 then
begin
WriteLn('Ввод закончен !');
WriteLn;
L:=False
end
else
begin
Read(B);
Kon:=Top;
Ua:=Nil; Ub:=Nil;
While Kon<>Nil do
begin
if Kon^.Nom=A then Ua:=Kon;
if Kon^.Nom=B then Ub:=Kon;
if (Ua<>Nil) and (Ub<>Nil) then Kon:=Nil;
if Kon<>Nil then Kon:=Kon^.Next
end;
if Ua=Nil then { A-новая вершина }
begin
New(ua);
Ua^.Nom:=A;
Ua^.Next:=Top;
Top:=Ua;
Ua^.Sv:=Nil
end;
if Ub=Nil then { B-новая вершина }
begin
New(Ub);
Ub^.Nom:=B;
Ub^.Next:=Top;
Top:=Ub;
Ub^.Sv:=Nil
end;

31

if Ua^.Sv=Nil then { нет дуг у вершины A }
begin
New(p);
Ua^.Sv:=P;
P^.Next:=Nil;
P^.Sv:=Ub
end
else { есть дуги }
begin
Q:=Ua^.Sv; { первая дуга }
New(p);
P^.Next:=Q^.Next;
Q^.Next:=P;
P^.Sv:=Ub { вставка после первой дуги }
end
end
end; { конец While }
Ua:=Top;
While Ua<>Nil do
begin
WriteLn('Вершина ', Ua^.Nom);
P:=Ua^.Sv;
if P<>Nil then Write('Последователи: ')
else Write('Последователей нет !');
While P<>Nil do
begin
Kon:=P^.Sv;
B:=Kon^.Nom;
Write(B,' ');
P:=P^.Next
end;
WriteLn;
Ua:=Ua^.Next
end;
Ch:=ReadKey { пауза }
End.