unit graftpu;

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

interface

const nmax=100;

{--- A graf-eljarasok --->
(ami csillaggal (*) van jelolve, azok vannak kesz):
*  procedure Ures(var g:Tgraf);
*  function Urese(const g:Tgraf):boolean;
  procedure Beolvas(var g:Tgraf);
* (...kiir) procedure Kiir(const G:Tgraf);
  function Pontszam(const g:Tgraf):egesz;
  function Elszam(const g:Tgraf):egesz;
  function BeillesztPont(var g:Tgraf; i:Tindex):boolean;
  function TorolPont(var g:Tgraf; i:Tindex; p:Tpont):boolean;
* (elbeszur) function Osszekot(var g:Tgraf; p,q:Tindex; h:real):boolean;
* (eltorol)  function Elszakit(var g:Tgraf; p,q:Tindex):boolean;
  function Elhossz(const g:Tgraf; p,q:Tindex):egesz;
  function KiinduloElekSzama(const g:Tgraf; p:Tindex):egesz;
  function SzomszedPont(const g:Tgraf; p:Tindex):Tindex;
  function PontErtek(const g:Tgraf; p:Tindex):Tpont;
<--- A graf-eljarasok ---}

{--- 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 ---}

{--- Grafok def. ---}
  ltomb=array[1..nmax] of tlista;
  csucslista=object
    private
    public
      procedure elbeszur(var m:ltomb; const p1,p2:integer);
      procedure eltorol(var m:ltomb; const p1,p2:integer);
      procedure autofeltolt(var m:ltomb);
      procedure graftorol(var m:ltomb);
      function vanel(const m:ltomb; const p1,p2:integer):boolean;
      procedure csucslistakiir(const m:ltomb; const p:integer); end;

  matrix=array[1..nmax,1..nmax] of boolean;
  elmatrix=object
    private
    public
      function vanel(const m:matrix; const p1,p2:integer):boolean;
      procedure eltorles(var m:matrix; const p1,p2:integer);
      procedure elbeszuras(var m:matrix; const p1,p2:integer);
      procedure elekkiiras(var m:matrix);
      procedure autofeltolt(var m:matrix);
      procedure graftorles(var m:matrix);
      function KiinduloElekDB(const m:matrix; const p:integer):integer; end;

  parrec=record
  elso,masodik:integer; end;
  fels=array[1..nmax] of parrec;
  ellista=object
    private
      akt:integer;
    public
      function vanel(const m:fels; p1,p2:integer):boolean;
      procedure elbeszur(var m:fels; const p1,p2:integer);
      procedure eltorol(var m:fels; const p1,p2:integer);
      procedure autofeltolt(var m:fels);
      procedure graftorol(var m:fels);
      procedure kiiras(const m:fels); end;

implementation

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

  procedure csucslista.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 csucslista.autofeltolt(var m:ltomb);
  var i:integer;
  begin
    for i:=1 to nmax do m[i].ures;
  end; {autofeltolt}

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

  function csucslista.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 csucslista.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}
{--- csucslista vege ---}

{--- Elmatrix kifejtve ---}
  function elmatrix.vanel(const m:matrix; const p1,p2:integer):boolean;
  begin vanel:=(m[p1,p2]); end;

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

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

  procedure elmatrix.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 elmatrix.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 elmatrix.graftorles(var m:matrix);
  begin  autofeltolt(m); {nem elegans, de hatasos} end;

  function elmatrix.KiinduloElekDB(const m:matrix; const p:integer):integer;
  var svdb:integer; i:integer;
  begin
    svdb:=0;
    for i:=1 to nmax do begin
      if (m[p,i]=true) then inc(svdb);
    end;
    kiinduloelekdb:=svdb;
  end; {kiinduloelekdb}

{--- Elmatrix vege ---}


{--- Ellista kifejtve ---}
function ellista.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 ellista.elbeszur(var m:fels; const p1,p2:integer);
begin
  if (akt<nmax) then begin
    inc(akt); m[akt].elso:=p1; m[akt].masodik:=p2;
  end; {if}
end; {elbeszur}

procedure ellista.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 ellista.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 ellista.graftorol(var m:fels);
begin
  autofeltolt(m); {van esztetikusabb, de ez is hatasos}
end;{graftorol}

procedure ellista.kiiras(const m:fels);
var i:integer;
begin
  for i:=1 to nmax do writeln(m[i].elso,' - ',m[i].masodik);
end; {kiiras}
{--- Ellista 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 --->

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 *

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 *

Ellista:
  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 *

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.