program grafos;
type PElem = ^Elem;
Elem = record
szam: integer;
kov: PElem ;
end;
type Tedge = record
edge: PElem;
megnezve:boolean;
end;

var
akt,uj,elso,utolso:PElem;
n,i,a,j,m,b:integer;
edges:array[1..10]of Tedge;
szom:array[1..10,1..10]of byte;
procedure Betesz(i,sz:integer);
begin
new(uj);
uj^.szam:=sz;
uj^.kov:=nil;
if edges[i].edge = nil then
edges[i].edge:=uj
else
begin
akt:=edges[i].edge;
while akt^.kov<> nil do
akt:=akt^.kov;
akt^.kov:=uj;
end;
end;
procedure kiir(i:integer);
begin
akt:=edges[i].edge;
while akt<> nil do
begin
write(akt^.szam,',');
akt:=akt^.kov;
end;
end;
procedure SorBatesz(nnev:integer);
var uj:PElem;
begin
new(uj);
uj^.szam:=nnev;
uj^.kov:=nil;
if elso = nil then
begin
elso:=uj;
utolso:=elso;
end
else
begin
utolso^.kov:=uj;
utolso:=uj;
end;
end;
procedure kivesz();
var temp:PElem;
begin
if elso <> nil then
begin
temp:=elso;
elso:=elso^.kov;
dispose(temp);
end;
end;

Function ures():boolean;
begin
if (elso = nil) then ures:=TRUE
else ures:=FALSE;
end;
procedure szelBejarGraf(nev:integer);
var akt:Pelem;
begin
SorBatesz(nev);
edges[nev].megnezve:=TRUE;
while(NOT ures()) do
begin
akt:= edges[elso^.szam].edge;
while akt<>nil do
begin
if (edges[akt^.szam].megnezve = FALSE ) then
begin
SorBatesz(akt^.szam);
edges[akt^.szam].megnezve:=TRUE;
end;
akt:=akt^.kov;
end;
write(elso^.szam,',');
kivesz;
end;
end;
procedure melyBejarGraf(akt:Pelem);
begin
if (akt = nil) then exit ;
if (edges[akt^.szam].megnezve = FALSE) then
begin
edges[akt^.szam].megnezve:=TRUE;
write(akt^.szam,',');
melyBejarGraf (edges[akt^.szam].edge);
end;
akt:=akt^.kov;
melyBejarGraf(akt);
end;
procedure szomszed;
begin
for i:=1 to n do
for j:=1 to n do
szom[i,j]:=0;
for i:=1 to n do
begin
akt:=edges[i].edge;
while akt<>nil do
begin
szom[i,akt^.szam]:=1;
akt:=akt^.kov;
end;
end;
for i:=1 to n do
begin
for j:=1 to n do
write(szom[i,j]);
writeln;
end;
end;
function kapcslista(o1,p1:integer):boolean;
begin
 akt:=edges[o1].edge;
while akt<>nil do
begin
if akt^.szam=p1 then
begin
kapcslista:=true;
exit;
end
else
akt:=akt^.kov;
end;
kapcslista:=false;
end;
procedure kozosszomszed(elso,masodik:integer);
begin
for i:=1 to n do
begin
if (i=elso) or (i=masodik) then
begin
//ha az i egyenlo az elsovel vagy masodikkal akkor ne csinaljon semmit
end
else if ((kapcslista(elso,i)) and (kapcslista(masodik,i)) and (kapcslista(i,elso)) and (kapcslista(i,masodik))) then
write(i,',');
end;
end;
begin

{writeln('Mennyi VERTEX van?');
readln(n);
for i:=1 to n do
begin
repeat
writeln('Kerem a(z) ',i,' vertex kapcsolatat');
readln(a);
if a<>0 then
betesz(i,a);
betesz(a,i);
until a=0;
end; }
n:=5;
betesz(1,2);
betesz(1,3);
betesz(1,4);
betesz(2,1);
betesz(2,4);
betesz(3,1);
betesz(4,1);
betesz(4,2);
betesz(4,5);
betesz(5,4);
writeln('Az edge tablazat');
for i:=1 to n do
begin
kiir(i);
writeln;
end;
writeln('Szelessegi bejaras');
szelbejargraf(1);
writeln;
for i:=1 to n do
edges[i].megnezve:=False;
writeln('Melysegi bejaras');
edges[1].megnezve:=TRUE;
write('1,');
melyBejarGraf( edges[1].edge);
writeln;
writeln('Szomszedsagi matrix');
szomszed;
writeln;
writeln('Kerek 1 VERTEXet!');
readln(b);
writeln('Kerek meg 1 VERTEXet!');
readln(m);
writeln;
writeln('Matrixos!');
if (szom[b,m]=1) and (szom[m,b]=1) then
writeln('Van kapcsolat!')
else
writeln('Nincs kapcsolat!');
writeln;
writeln('Listas');
if (kapcslista(b,m)=true) and (kapcslista(m,b)=true) then
writeln('van kapcsolat!')
else
writeln('Nincs kapcsolat!');
write('Kozos szomszed:');
kozosszomszed(b,m);

readln;
end.