Benutzer:Scravy/delphi
aus Wikipedia, der freien Enzyklopädie
program baum;
uses SysUtils;
{$APPTYPE CONSOLE}
type
TBaumMessage = procedure(msg: string);
type
TKnoten = class(TObject) private _inhalt: integer; _links: TKnoten; _rechts: TKnoten; public property inhalt: integer read _inhalt write _inhalt; property links: TKnoten read _links write _links; property rechts: TKnoten read _rechts write _rechts; constructor Create(x: integer = 0); end;
type
TBaum = class(TObject) private FOnMessage: TBaumMessage; FOnShortMessage: TBaumMessage; _wurzel: TKnoten; _anzahl: integer; function _exists(k: TKnoten; x: integer): boolean; function _search(k: TKnoten; x: integer): TKnoten; overload; function _search(k: TKnoten; x: integer; var parent: TKnoten): TKnoten; overload; procedure wlr(k: TKnoten); procedure lwr(k: TKnoten); procedure lrw(k: TKnoten); procedure h(k: TKnoten; rel_max: integer; var abs_max: integer); protected procedure showMessage(msg: string); overload; procedure showMessage(msg: integer); overload; public constructor Create; function leer: boolean; function exists(x: integer): boolean; function search(x: integer): TKnoten; overload; function search(x: integer; var parent: TKnoten): TKnoten; overload; procedure einfuegen(x: integer); procedure loeschen(x: integer); procedure preorder; procedure inorder; procedure postorder; property anzahl: integer read _anzahl; function hoehe: integer; property OnMessage: TBaumMessage read FOnMessage write FOnMessage; property OnShortMessage: TBaumMessage read FOnShortMessage write FOnShortMessage; end;
constructor TKnoten.Create(x: integer = 0); begin
self._inhalt := x; self._links := NIL; self._rechts := NIL;
end;
procedure TBaum.showMessage(msg: string); begin
if assigned(self.OnMessage) then self.OnMessage(msg);
end;
procedure TBaum.showMessage(msg: integer); begin
if assigned(self.OnMessage) then self.OnShortMessage(IntToStr(msg));
end;
{ rekursive suche OB ein gegebener wert im baum ist } function TBaum._exists(k: TKnoten; x: integer): boolean; begin
if x = k.inhalt then
Result := true
else
if x < k.inhalt then
if k.links <> NIL then
Result := self._exists(k.links, x)
else
Result := false
else
if k.rechts <> NIL then
Result := self._exists(k.rechts, x)
else
Result := false;
end;
{ rekursive suche nach einem gegebenen wert;
gibt zeiger auf den knoten zurück }
function TBaum._search(k: TKnoten; x: integer): TKnoten; begin
if x = k.inhalt then
Result := k
else
if x < k.inhalt then
if k.links <> NIL then
Result := self._search(k.links, x)
else
Result := NIL
else
if k.rechts <> NIL then
Result := self._search(k.rechts, x)
else
Result := NIL;
end;
function TBaum._search(k: TKnoten; x: integer; var parent: TKnoten): TKnoten; var
parent_node: TKnoten;
begin
if x = k.inhalt then
Result := k
else
if x < k.inhalt then
if k.links <> NIL then
Result := self._search(k.links, x)
else
Result := NIL
else
if k.rechts <> NIL then
Result := self._search(k.rechts, x)
else
Result := NIL;
end;
procedure TBaum.wlr(k: TKnoten); begin
self.ShowMessage(k.inhalt); if k.links <> NIL then self.wlr(k.links); if k.rechts <> NIL then self.wlr(k.rechts);
end;
procedure TBaum.lwr(k: TKnoten); begin
if k.links <> NIL then self.lwr(k.links); self.ShowMessage(k.inhalt); if k.rechts <> NIL then self.lwr(k.rechts);
end;
procedure TBaum.lrw(k: TKnoten); begin
if k.links <> NIL then self.lrw(k.links); if k.rechts <> NIL then self.lrw(k.rechts); self.ShowMessage(k.inhalt);
end;
procedure TBaum.h(k: TKnoten; rel_max: integer; var abs_max: integer); begin
if k.links <> NIL then self.h(k.links, rel_max+1, abs_max); if k.rechts <> NIL then self.h(k.rechts, rel_max+1, abs_max); if rel_max > abs_max then abs_max := rel_max;
end;
constructor TBaum.Create;
begin
self._wurzel := NIL; self._anzahl := 0;
end;
function TBaum.leer: boolean; begin
Result := self._wurzel = NIL;
end;
function TBaum.exists(x: integer): boolean; begin
if not self.leer then Result := self._exists(self._wurzel, x) else Result := false;
end;
function TBaum.search(x: integer; var parent: TKnoten): TKnoten; begin
if not self.leer then Result := self._search(self._wurzel, x, parent) else Result := NIL;
end;
function TBaum.search(x: integer): TKnoten; begin
if not self.leer then Result := self._search(self._wurzel, x) else Result := NIL;
end;
procedure TBaum.einfuegen(x: integer); var
neu: TKnoten; stop: boolean; h: TKnoten;
begin
neu := TKnoten.Create(x); stop := false; h := self._wurzel;
if (not self.leer) and (not self.exists(x)) then
begin
while not stop do
if x < h.inhalt then
if h.links <> NIL then
h := h.links
else
stop := true
else
if h.rechts <> NIL then
h := h.rechts
else
stop := true;
if x < h.inhalt then
h.links := neu
else
h.rechts := neu;
self.showMessage('eingefuegt');
end
else
if self.leer then
begin
self._wurzel := neu;
self.showMessage('eingefuegt');
self._anzahl := self._anzahl + 1;
end
else
self.showMessage('existiert bereits');
end;
procedure TBaum.loeschen(x: integer); var
knoten_which_gave_birth_to_the_knoten_which_has_to_fullfill_its_destiny: TKnoten; knoten_which_is_to_be_erased_by_the_cruel_hand_of_death: TKnoten;
begin
if self.leer then
begin
self.showMessage('Keine Elemente zum Löschen - Baum ist leer');
end
else
begin
knoten_which_gave_birth_to_the_knoten_which_has_to_fullfill_its_destiny := TKnoten.Create;
knoten_which_is_to_be_erased_by_the_cruel_hand_of_death := self._search(self._wurzel, x, knoten_which_gave_birth_to_the_knoten_which_has_to_fullfill_its_destiny);
if (knoten_which_is_to_be_erased_by_the_cruel_hand_of_death.links = NIL) and (knoten_which_is_to_be_erased_by_the_cruel_hand_of_death.rechts = NIL) then
begin
// Fall 1 - Knoten ist ein Blatt
end
else if (knoten_which_is_to_be_erased_by_the_cruel_hand_of_death.links <> NIL) xor (knoten_which_is_to_be_erased_by_the_cruel_hand_of_death.rechts <> NIL) then
begin
// Fall 2 - Der Knoten hat ein Kind
end
else
begin
// Fall 3 - Der Knoten ist selbst eine Wurzel zweier Knoten
end; end;
end;
procedure TBaum.preorder; begin
if not self.leer then
begin
self.ShowMessage('Preorder (WLR)');
self.wlr(self._wurzel);
end
else
self.ShowMessage('Baum ist leer');
end;
procedure TBaum.inorder; begin
if not self.leer then
begin
self.ShowMessage('InOrder (LWR)');
self.lwr(self._wurzel);
end
else
self.ShowMessage('Baum ist leer');
end;
procedure TBaum.postorder; begin
if not self.leer then
begin
self.ShowMessage('Postorder (LRW)');
self.lrw(self._wurzel);
end
else
self.ShowMessage('Baum ist leer');
end;
function TBaum.hoehe: integer; var
abs_max: integer;
begin
abs_max := 1; if not self.leer then begin self.h(self._wurzel, 1, abs_max); Result := abs_max; end else Result := 0;
end;
procedure mywriteln(msg: string); begin
writeln(msg);
end;
procedure mywrite(msg: string); begin
write(msg+' ');
end;
var
auswahl: char; unser_baum: TBaum; eingabe: string; x: integer;
begin
unser_baum := TBaum.Create; unser_baum.OnMessage := mywriteln; unser_baum.OnShortMessage := mywrite;
auswahl := 'm';
while auswahl <> '0' do
begin
case auswahl of
'1':
begin
mywriteln('Suchen nach');
readln(eingabe);
if trystrtoint(eingabe, x) then
if unser_baum.exists(x) then
mywriteln('Vorhanden!')
else
mywriteln('Nicht vorhanden.')
else
mywriteln('Keine Zahl!');
auswahl := 'm';
readln;
end;
'2':
begin
mywriteln('Einfuegen');
readln(eingabe);
if trystrtoint(eingabe, x) then
unser_baum.einfuegen(x)
else
auswahl := 'm';
end;
'3':
begin
mywriteln('Loeschen');
readln(eingabe);
if trystrtoint(eingabe, x) then
unser_baum.loeschen(x)
else
mywriteln('Keine Zahl!');
auswahl := 'm';
readln;
end;
'4':
begin
unser_baum.preorder;
auswahl := 'm';
readln;
end;
'5':
begin
unser_baum.inorder;
auswahl := 'm';
readln;
end;
'6':
begin
unser_baum.postorder;
auswahl := 'm';
readln;
end;
'7':
begin
mywriteln(IntToStr(unser_baum.anzahl)+' Knoten im Baum!');
auswahl := 'm';
readln;
end;
'8':
begin
mywriteln('Baumhoehe '+IntToStr(unser_Baum.hoehe));
auswahl := 'm';
readln;
end;
else
mywriteln('Option wählen');
mywriteln('1: Suchen');
mywriteln('2: Einfuegen');
mywriteln('3: Loeschen');
mywriteln('4: Ausgabe WLR (PreOrder)');
mywriteln('5: Ausgabe LWR (InOrder)');
mywriteln('6: Ausgabe LRW (PostOrder)');
mywriteln('7: Anzahl Knoten');
mywriteln('8: Hoehe (oder Tiefe?) des Baumes');
mywriteln('0: Shut tha fuck up.');
readln(auswahl);
end;
end;
end.
