program b7auf2RR;
uses crt;
type pkanten = ^kanten;
pgraphen = ^graphen;
graphen = record
knoten : integer;
next : pgraphen;
kanten : pkanten;
end;
kanten = record
knoten : pgraphen;
next : pkanten;
end;
var graph : pgraphen;
n : integer;
function Graphenanlegen (k: integer):pgraphen; {Aufbau von hinten}
var i: integer;
p, anfang: pgraphen;
begin
anfang:=nil;
for i:= k downto 1 do
begin
new (p);
p^.knoten:=i;
p^.next:= anfang;
anfang:=p;
end;
Graphenanlegen:=anfang;
end;
function ZeigeraufKnoten (k:integer; g:pgraphen):pgraphen; {Liefert Zeiger auf Knoten k im Graph g}
begin
if g = nil then
ZeigeraufKnoten:=nil
else
begin
while g^.knoten <> k do
g:=g^.next;
ZeigeraufKnoten:=g
end
end;
procedure Kanteneinfuegen (g:pgraphen); {Kanten einlesen und einfuegen}
var a,b:integer;
function Keinfuegen (g:pgraphen; a,b:integer): pgraphen;
var k, kante:pkanten;
p,q:pgraphen;
begin
p:=ZeigeraufKnoten(a,g); {Knoten a finden}
q:=ZeigeraufKnoten(b,g); {Knoten b finden}
new(kante); {neue Kante anlegen}
kante^.knoten:=q; {Folgeknoten zuweisen}
if p^.kanten=nil then {noch keine Kante da?}
p^.kanten:=kante {dann Kante direkt einfgen}
else {sonst bis zur letzten Kante weiterhangeln}
begin
k:=p^.kanten;
while k^.next <> nil do
k:=k^.next;
k^.next:=kante; {und anh„ngen}
end;
Keinfuegen:= g;
end;
begin
writeln ('Eingabe der Kanten a b (Ende mit 0 0) ');
repeat
readln (a,b);
if (a<>0) and (b<> 0) then
Keinfuegen (g,a,b);
until a = 0;
end; {Kanteneinfuegen}
procedure Graphausgabe (g: pgraphen);
var k:pkanten;
begin
if g=nil then writeln('Graph ist leer') else
begin
repeat
writeln('Knoten: ',g^.knoten);
k:=g^.kanten;
while k<>nil do
begin
write ('Kante: ', g^.knoten);
writeln (k^.knoten^.knoten);
k:=k^.next;
end;
g:=g^.next;
until g=nil;
end;
end; {Graphausgabe}
procedure Kantenausgabe (k:pkanten);
begin
while k <> nil do
begin
writeln (k^.knoten^.knoten);
k:=k^.next;
end;
end; {Kantenausgabe}
procedure Knotenloeschen (k:integer; var g: pgraphen); {call by reference!
sonst kann 1. Knoten nicht gel”scht werden}
var h, hilf:pgraphen;
kante, loeschkante: pkanten;
procedure Kantenloeschen (kn:pgraphen); {loescht alle Kanten des Knoten kn}
var pkante, loeschkante:pkanten;
begin
while kn^.kanten <> nil do
begin
pkante:=kn^.kanten;
if pkante^.next = nil then
begin
kn^.kanten := nil;
dispose (pkante)
end
else
begin
while pkante^.next^.next <> nil do
pkante:=pkante^.next;
loeschkante:= pkante^.next;
pkante^.next:=nil;
dispose (loeschkante)
end;
end;
end; {Kantenloeschen}
begin
h:=g; {nach Kanten die auf k zeigen suchen und l”schen}
while h <> nil do {fr alle Knoten tue}
begin
if h^.kanten <> nil then
begin
if h^.kanten^.knoten^.knoten = k then {erste Kante zu l”schen?}
begin
loeschkante:=h^.kanten;
h^.kanten:=h^.kanten^.next;
dispose (loeschkante);
end
else
begin {gehe alle anderen Kanten durch}
kante:=h^.kanten;
while kante^.next <> nil do
begin
if kante^.next^.knoten^.knoten = k then
begin
loeschkante:=kante^.next;
kante^.next:=kante^.next^.next;
dispose (loeschkante);
end
else
kante:=kante^.next ;
end;
end;
end;
h:=h^.next
end;
hilf:=Zeigeraufknoten(k, g); {Knoten l”schen}
Kantenloeschen (hilf);
if g^.knoten=k then
begin
hilf:=g;
g:=g^.next;
dispose (hilf)
end
else
begin
h:=g;
while h^.next^.knoten <> k do {Vorg„nger des zu l”schenden Knoten suchen}
h:=h^.next;
hilf:=h^.next; {auf zu l”schenden Knoten zeigen}
h^.next:=h^.next^.next; {šberspringen}
dispose (hilf)
end;
end; {Ende Knotenloeschen}
function Abstand (k:integer; g:pgraphen):pkanten;
var KListe, KZeiger, KZeiger2,Kante, a, pa, paa: pkanten;
function Abgleich (Einerknoten:pgraphen;Liste:pkanten):pkanten; {Streicht Einerknoten aus Liste}
var hilf, loesch:pkanten;
begin
while (Liste <> nil) and (Liste^.knoten=Einerknoten) do {Vergleich des ersten Eintrags}
begin
Liste:=Liste^.next;
dispose(hilf);
hilf:=Liste
end ;
hilf:=Liste;
while (hilf<>nil) and (hilf^.next <> nil) do
if hilf^.next^.knoten=Einerknoten then
begin
loesch:=hilf^.next;
hilf^.next:=hilf^.next^.next;
dispose (loesch)
end
else
begin
hilf:=hilf^.next;
end;
Abgleich:=Liste;
end;
begin
KListe:=nil; {alle Knoten mit Entfernung 2 in Liste aufnehmen}
KZeiger:=ZeigeraufKnoten(k,g)^.kanten;
while KZeiger<>nil do {fr alle Kanten tue}
begin
KZeiger2:= KZeiger^.knoten^.kanten; {zeigt auf Kanten des benachbarten Knoten}
while KZeiger2<> nil do {Durchlaufen der Kanten des benachbarten Knoten}
begin
new(Kante);
Kante^.knoten:=KZeiger2^.knoten;
Kante^.next:=KListe; {vorne einh„ngen der neunen Kante}
KListe:=Kante;
KZeiger2:=KZeiger2^.next
end;
KZeiger:=KZeiger^.next
end ;
{alle Knoten mit Entfernung <2 entfernen}
KListe:=Abgleich(Zeigeraufknoten(k,g),Kliste); {Schlinge entfernen}
while KZeiger<>nil do {fuer alle Kanten tue}
begin
KListe:=Abgleich(KZeiger^.Knoten, KListe); {Nachbarknoten, Liste}
KZeiger:=KZeiger^.next;
end;
Abstand:=KListe;
end;
{*************Hauptprogramm*******************}
begin
writeln('Anzahl der Knoten? ');
readln(n);
graph:=Graphenanlegen (n);
Kanteneinfuegen (graph);
writeln ('Graphausgabe: ');
readln;
Graphausgabe (graph);
readln;
writeln('Knoten l”schen: ');
readln(n);
Knotenloeschen (n,graph);
Graphausgabe (graph);
writeln ('Abstand 2 von welchem Knoten?');
readln (n);
writeln('Folgende Knoten sind im Abstand 2: ');
Kantenausgabe (Abstand(n,graph));
readln;
end.
