program grafok;

{Grafok abrazolasa a harom legismertebb modszerrel}
{Szamoskozi Peter - szamosp(a)inf.elte.hu}
{GPL - 2001. marcius 14.}

const nmax=100;

{--- A lista-unit reszei ---}
type
  telem=integer; tlistaelemmut=^tlistaelem;
  tlistaelem=record
    ertek:telem; kov:tlistaelemmut; end;
  tlista=object
   private
     fej:tlistaelemmut; akt:tlistaelemmut; hiba:boolean;
   public
     procedure ures;
     function ures_e:boolean;
     procedure elejere;
     procedure kovetkezore;
     procedure elemodosit(e:telem);
     function elemertek:telem;
     procedure beszurele(e:telem);
     procedure beszurmoge(e:telem);
     function vege_e:boolean;
     function hibas_e:boolean;
     procedure kihagy; end;
{--- Lista-unit def. vege ---}

{--- Lista-unit eljarasok ---}
procedure tlista.ures;
begin fej:=nil; akt:=nil; hiba:=false; end;

function tlista.ures_e:boolean;
begin ures_e:=(fej=nil); end;

procedure tlista.elejere;
begin akt:=fej; end;

procedure tlista.kovetkezore;
begin
if ures_e then hiba:=true
     else if vege_e then hiba:=true else akt:=akt^.kov;
end;

function tlista.vege_e:boolean;
begin if ures_e then hiba:=true else vege_e:=(akt^.kov=nil); end;

function tlista.elemertek:telem;
begin if ures_e then hiba:=true else elemertek:=akt^.ertek; end;

procedure tlista.elemodosit(e:telem);
begin if ures_e then hiba:=true else akt^.ertek:=e; end;

function tlista.hibas_e:boolean;
begin hibas_e:=hiba; hiba:=false; end;

procedure tlista.beszurmoge(e:telem);
var uj:Tlistaelemmut;
begin
  new(uj); { Ha nem sikerult lefoglalni, akkor "nil"-el ter vissza }
  if uj<>nil then begin
    uj^.ertek:=e;
    uj^.kov:=nil;
    if ures_e then begin fej:=uj; akt:=uj; end
      else begin
      uj^.kov:=akt^.kov;
      akt^.kov:=uj;
      akt:=uj; end; end
  else hiba:=true;
end;

procedure tlista.beszurele(e:telem);
var uj:Tlistaelemmut;
begin
  new(uj);
  if uj<>nil then begin
    uj^.ertek:=e;
    uj^.kov:=nil;
    if ures_e then begin
       fej:=uj;
       akt:=uj; end
     else begin
       uj^.kov:=akt^.kov;
       akt^.kov:=uj;
       uj^.ertek:=akt^.ertek;
       akt^.ertek:=e; end; end
   else hiba:=true;
end;

procedure tlista.kihagy;
var elozo:Tlistaelemmut;
begin
  if ures_e then hiba:=true
    else begin
     if akt=fej then begin
        fej:=akt^.kov;
        dispose(akt);
        akt:=fej; end
       else begin
         elozo:=fej;
         while elozo^.kov<>akt do
           elozo:=elozo^.kov;
         elozo^.kov:=akt^.kov;
         dispose(akt);
         akt:=elozo; end;
    end;
end;
{--- Lista-unit eljarasok vege ---}

{--- Graf-eljarasok ---}
procedure csucslista;
{ a[1] - lista1
            -elem1
            -elem2...
  a[2] - lista2
            -elem1
            -elem2...
  ...
  a[i] - listai
            -elem1
            -elem2...
 * Ahol a[i] az i. e'l, a lista pedig azt tartalmazza,
         mely elekkel van kapcsolatban *}
type ltomb=array[1..nmax] of tlista;

  procedure elbeszur(var m:ltomb; const p1,p2:integer);
  begin
    m[p1].beszurmoge(p2);
  end; {elbeszur}

  procedure eltorol(var m:ltomb; const p1,p2:integer);
  begin
    m[p1].elejere;
    while (m[p1].elemertek<>p2) do m[p1].kovetkezore;
    m[p1].kihagy;
  end; {eltorol}

  procedure autofeltolt(var m:ltomb);
  var i:integer;
  begin
    for i:=1 to nmax do m[i].ures;
  end; {autofeltolt}

  procedure graftorol(var m:ltomb);
  begin
    autofeltolt(m); {nem szep, de hatasos}
  end; {graftorol}

  function vanel(const m:ltomb; const p1,p2:integer):boolean;
  begin
   m[p1].elejere;
   while ( not(m[p1].vege_e) or (m[p1].elemertek<>p2) ) do m[p1].kovetkezore;
   vanel:=(not(m[p1].vege_e));
  end; {van el}

  procedure csucslistakiir(const m:ltomb; const p:integer);
  var i:integer;
    procedure csucskiir(const m:ltomb; const p:integer);
    begin {csucskiir}
      m[p].elejere; writeln(m[p].elemertek);
      while not(m[p].vege_e) do begin
        m[p].kovetkezore;
        write(' \ -> ',m[p].elemertek);
      end; {while}
    end; {csucskiir}
  begin {csucslistakiir}
    writeln;
    for i:=1 to nmax do begin csucskiir(m,i); writeln; end;
  end; {csucslistakiir}

begin {csucslista}
end; {csucslista}

procedure elmatrix;
{ a[1,1] a[1,2] ... a[1,m]
  a[2,1] a[2,2] ... a[2,m]
  ...
  a[n,1] a[n,2] ... a[n,m]
 * Ahol minden pont (a[i.j]) egy logikai ertek:
  azon ket pont kozott van-e kapcsolat *}
type matrix=array[1..nmax,1..nmax] of boolean;

 function vanel(const m:matrix; const p1,p2:integer):boolean;
 begin vanel:=(m[p1,p2]); end;

 procedure eltorles(var m:matrix; const p1,p2:integer);
 begin m[p1,p2]:=false; end;

 procedure elbeszuras(var m:matrix; const p1,p2:integer);
 begin m[p1,p2]:=true; end;

 procedure elekkiiras(var m:matrix);
 var i,j:integer;
   function kiir(const p1,p2:integer):byte;
   begin
     if m[p1,p2]=true then kiir:=1 else kiir:=0;
   end; {kiir}
 begin
   for i:=1 to nmax do begin
     for j:=1 to nmax do begin
       if ( (j mod 40)<=39 ) then write(kiir(i,j)) else writeln(kiir(i,j));
     end; {j}
     if ( (i mod 25)=24 ) then begin
       writeln; writeln('Tovabb: Enter'); readln; end;
   end; {i}
 end; {elekkiiras}

 procedure autofeltolt(var m:matrix);
 var i,j:integer;
 begin
   for i:=1 to nmax do begin
     for j:=1 to nmax do m[i,j]:=false;
   end; {i}
 end; {autofeltolt}

 procedure graftorles(var m:matrix);
 begin  autofeltolt(m); {nem elegans, de hatasos} end;

begin {elmatrix}
end; {elmatrix}

procedure ellistas;
{ a[i]-a[j]
  a[k]-a[l]
  ...
  a[i]-a[k]...
 * Ahol csak azokat a parokat taroljuk (pl. egy listaban),
  amelyek kozott vamn kapcsolat *}
type parrec=record
 elso,masodik:integer; end;
fels=array[1..nmax] of parrec;
var akt:integer;

  function vanel(const m:fels; p1,p2:integer):boolean;
  var i:integer;
  begin
    i:=1;
    while ( ((m[i].elso<>p1) and (m[i].masodik<>p2)) or (i<=nmax) ) do inc(i);
    vanel:=(i<=nmax);
  end; {vanel}

  procedure elbeszur(var m:fels; p1,p2:integer);
  begin
    if (akt<nmax) then begin
      inc(akt); m[akt].elso:=p1; m[akt].masodik:=p2;
    end; {if}
  end; {elbeszur}

  procedure eltorol(var m:fels; const p1,p2:integer);
    {Nem igazan szep. Jobb - de kevesbe gyors - volna
    a "hatrebb" levo elemek "tologatasaval" megoldani}
  var i:integer;
  begin
    i:=1;
    while ( ((m[i].elso<>p1) and (m[i].masodik<>p2)) or (i<=nmax) ) do inc(i);
    if (i<=nmax) then begin m[i].elso:=0; m[i].masodik:=0; end;
  end; {eltorol}

  procedure autofeltolt(var m:fels);
  var i:integer;
  begin
    for i:=1 to nmax do begin
      m[i].elso:=0; m[i].masodik:=0;
    end; {for}
  end; {autofeltolt}

  procedure graftorol(var m:fels);
  begin
    autofeltolt(m); {van esztetikusabb, de ez is hatasos}
  end;{graftorol}

  procedure kiiras(const m:fels);
  var i:integer;
  begin
    for i:=1 to nmax do writeln(m[i].elso,' - ',m[i].masodik);
  end; {kiiras}

begin {ellistas}
end; {ellistas}

begin
{Megirando eljarasok - mindegyik tipusra:
adott_elem_ertekenek_lekerdezese (van ilyen el?)
graf_letrehozasa (egy el letrehozasa -> ujabb elek hozzaadasa)
graf_torlese (minden el torlese -> el torlese, bejaras)
beszuras (uj el)
torles (el megszuntetese)
feltoltes (el hozzaadasa)
kiiras (vegigmenetel az eleken)}
end.