Клики на графе (Pascal)

[prorock55]

Есть программа для поиска клик на графе, ввод структуры (списка)смежности в ней происходит из файла clique.in, а вершины найденных клик записываются в файл clique.out.Нужно сделать так чтобы структуру смежности программа могла читать не только из файла, а и был возможен её ввод с клавиатуры , а результат роботы (вершины найденных клик)выводился на экран. Исходные данные для расчета по программе алгоритма представляются в текстовом файле со следующей структурой смежности Adj[x]:
• в первой строке файла содержится количество строк в структу-
ре смежности, которое равно числу вершин в графе;
• далее для каждой вершины в отдельной строке указывается
номер самой вершины, количество вершин, смежных с дан-
ной, и список этих вершин.

Program PgmClique;
uses CRT, DOS;
Const
nVertex=100;
nAdjacent=1000;
Type
TypeVertex=array [1..nVertex] of Integer;
TypeAdjacent=array [1..nAdjacent] of integer;
Var
f :Text;
m :Integer;
Adj :TypeAdjacent;
Fst :TypeVertex;
Nbr :TypeVertex;
 
Vtx :TypeVertex;
S :TypeVertex;
nS :Integer;
N :TypeVertex;
 
D :TypeVertex;
 
 
Z :TypeVertex;
 
Procedure PrintClique; FORWARD;
Procedure Subtract(x:Integer; Var kZ,nZ:Integer ); FORWARD;
Procedure Intersection( v,kM,nM:Integer; Var kMw,nMw:Integer;
Var M:TypeVertex ); FORWARD;
Procedure View( v:Integer; Var kN,nN, kD,nD, kZ,nZ:Integer
); FORWARD;
Procedure Clique( kN,nN,kD,nD,kZ,nZ:Integer ); FORWARD;
Procedure Init( Var yes :Boolean );
Var
i,j,k :Integer;
begin
for i:=1 to m do
for j:=1 to Nbr[i] do begin
yes:=FALSE;
for k:=1 to m do
if Adj[Fst[i] +j] = Vtx[k] then begin
yes:=TRUE;
Adj [ Fst [ i ] + j ] := k ;
break;
end;
if not yes then exit;
end;
end;
Procedure PrintClique;
Var
i :Integer;
begin
for i:=1 to nS do Write (f,Vtx[S[i]]:3); WriteLn(f);
end;
Procedure Intersection( v,kM,nM:Integer;
Var kMw,nMw:Integer; Var M:TypeVertex ) ;
Var
i,j,k :Integer;
yes :Boolean;
begin
kMw:=kM+nM;
nMw:=0;
for i:=1 to nM do
for j:=1to Nbr[v] do
if M[kM+i]=Adj[Fst[v]+j] then begin
nMw:=nMw+1;
M[kMw+nMw] :=M[kM+ i];
break;
end;
end;
Procedure Subtract( x:Integer; Var kZ,nZ:Integer );
Var
i,j,k :Integer;
yes :Boolean;
begin
for i:=1 to nZ do
if Z[kZ+i]=x then begin
nZ:=nZ-1;
for k:=i to nZ do Z[kZ+k]:=Z[kZ+k+1];
break;
end;
for j:=1 to Nbr[x] do
for i:=1 to nZ do
if Z[kZ+i]=Adj[Fst[x]+j] then begin
nZ:=nZ-1;
for k:=i to nZ do Z[kZ+k]:=Z[kZ+k+1];
break;
end;
end;
Procedure Clique( kN,nN,kD,nD,kZ,nZ:Integer );
 
Var
i,j,x :Integer;
begin
if (nN=0) and (nD=0) then
PrintClique
else if nN<>0 then begin
x:=N[kN+nN];
View(x,kN,nN,kD,nD,kZ,nZ);
 
Subtract(x,kZ,nZ); (* Z=Z\{x} и Z=Z\Adj[x] *)
while nZ<>0 do begin
x:=Z[kZ+nZ];
View(x,kN,nN,kD,nD,kZ,nZ) ;
nZ:=nZ-1; (* Z=Z\{x} *)
end;
end;
end;
Procedure View(v:Integer; Var kN,nN,kD,nD,kZ,nZ:Integer);
Var
i,k :Integer;
kNw,nNw :Integer;
kDw,nDw :Integer;
kZw,nZw :Integer;
begin
for i:=1to nN do
if N[kN+i]=v then begin
nN:=nN-1;
for k:=i to nN do N[kN+k]:=N[kN+k+1];
break;
end;
nS:=nS+1;
S[nS]:=v;
Intersection(v,kN,nN,kNw,nNw,N); {N и Adj[v]}
Intersection(v,kD,nD,kDw,nDw,D); {D и Adj[v]}
(* Формирование начального Z=N нового уровня *)
kZw:=kZ+nZ;
nZw:=nNw;
for i:=1 to nNw do Z[kZw+i]:=N[kNw+i];
(* Исследование поддеревьев нового уровня *)
Clique(kNw,nNw,kDw,nDw,kZw,nZw);
(* Формирование S=S\{v} *)
nS:=nS-1;
(* Формирование D=D+{v} *)
nD:=nD+1;
D[kD+nD]:=v;
end;
Var
kN,nN, kD,nD, kZ,nZ :Integer;
i,j :Integer;
yes :Boolean;
begin
Assign (f,'Clique.in');
Reset (f); {Файл открыт для чтения}
{Ввод списка смежности}
Read(f,m); {Количество строк в списке}
Fst[1]:=0; {Указатель начала первой строки списка}
for i:=1 to m do begin
Read(f,Vtx[i]); {Метка вершины}
Read(f,Nbr[i]); {Количество вершин в списке}
for j:=1 to Nbr[i] do Read(f,Adj[Fst[i]+j]);
{Список смежных вершин}
Fst[i+1]:=Fst[i]+Nbr[i]; {Указатель начала следующей
строки в списке}
end;
Close(f);
Assign(f,'Clique.out');
Rewrite(f); {Файл открыт для записи}
Init(yes);
if not yes then begin
WriteLn(f,'Плохая структура смежности графа!');
Close (f);
exit;
end;
{Формирование начальных множеств: S, D, N, Z}
nS:=0;
kD:=0; nD:=0; {D - пустое множество}
kN:=0; nN:=m; {N - все вершины графа}
for i:=1to m do N[i]:=i;
kZ:=0; nZ:=m; {Z - для исследования доступны все вершины}
for i:=1 to m do Z[i]:=i;
Clique(kN,nN,kD,nD,kZ,nZ); {Рекурсивное выделение
клик графа}
close(f);
end.

Пример структуры файлов Clique.in и Clique.out