Avl Bäume
spacer
Autor Nachricht
Btl
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 20:43 
Ich hab mal ne frage , ich soll eine graphik oder so programmieren .. eines avl baumes und die vater funktion hab ich schon jedoh weiß ich nicht wie die kinder funktionen gehen...

ausblenden Delphi-Quelltext markieren
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
function fktrkind(t:array of integer;knoten:integer):integer;
var i:integer;
begin
for i:=0 to length(t) do
begin
if t[i]=knoten then
begin
result:=i+1;
end;
end;
end;


mein rechtes kind funktioniert aber das linke kind funktioniert nicht könnte mir vlt jemadn helfen ,,, ich hab mir gedacht beim linken macht man anstatt +1 -1 aber das klappt nicht bei jeder zahl ... dankee ;)

Moderiert von user profile iconGausi: Delphi-Tags hinzugefügt
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Werbung ausblenden? Dann registriere Dich kostenlos. Weitere Gründe für eine Registrierung.


Werbung ausblenden? Dann registriere Dich kostenlos. Weitere Gründe für eine Registrierung.
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Di 15.11.11 20:51 
Wenn ich das richtig sehe, willst du die hochdynamische AVL-Baumstruktur über ein Array abbilden. Das ist aber komplett unsinnig. Da musst du schon mit Pointern bzw. Objekten u.ä. arbeiten.

Ein Objekt TAVLKnoten enthält dann z.B. je einen Zeiger auf den Vater und die beiden Söhne.

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 20:58 
ich hab keine ahnung aber sowas wie pointer haben wir nicht gemacht und mein rechtes kind funkttioniert ja .)

Moderiert von user profile iconNarses: Beiträge zusammengefasst

ja wir haben nur dieses ab bekommen.
Einloggen, um Attachments anzusehen!
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Di 15.11.11 20:59 
Ihr kennt keine Pointer, aber sollt einen AVL-Baum implementieren? :shock:

Wie seht denn z.B. dein Code zum Einfügen eines neuen Elementes und der nachfolgenden Ausbalancierung des Baumes aus?

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 21:00 
ausblenden volle Höhe Delphi-Quelltext markieren
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;
vater:array of integer ;

implementation

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(vater, 10);
vater[0]:=2;
vater[1]:=4;
vater[2]:=2;
vater[3]:=5;
vater[4]:=0;
vater[5]:=5;
vater[6]:=6;
vater[7]:=6;
vater[8]:=8;
vater[9]:=1;
end;

function fktwurzel(t:array of integer):integer;
var i:integer;
begin
for i:=0 to length(t) do
begin
if t[i]=0 then
begin
result:=i+1;
end;
end;
end;

function fktlkind(t:array of integer;knoten:integer):integer;
var i:integer;
begin
for i:=0 to length(t) do
begin
if t[i]=knoten then
begin
result:=i+1;
end;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var wurzel:integer;
begin
wurzel:=fktwurzel(vater);
showmessage(inttostr(wurzel));
end;


procedure TForm1.Button2Click(Sender: TObject);
var lkind, knoten:integer;
begin
knoten:=strtoint(edit1.Text);
lkind:=fktlkind(vater, knoten);
showmessage(inttostr(lkind));
end;

end.



bis jetzt sieht es so aus und funktioniert auch :)

Moderiert von user profile iconGausi: Delphi-Tags hinzugefügt
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Di 15.11.11 21:06 
joah...

Da würde ich sagen, dass du zusätzlich zu dem Vater-Array auch noch ein Linker-Sohn-Array und ein Rechter-Sohn-Array brauchst und das dann zur Abfrage verwendest. Das soll dann wohl genauso starr initialisiert werden wie das Vater-Array. :nixweiss:

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 21:07 
ja so soll es glaub ich sein aber wie bekomm ich einen linken hin ?
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Di 15.11.11 21:16 
Bau dir zwei weitere Arrays, schau dir das Bild in der Aufgabe an und fülle es entsprechend. Dein "rechtes Kind" dürfte ja auch noch gar nicht funktionieren.

Das rechte-Kind-Array sollte so aussehn

ausblenden Quelltext markieren
1:
rk=(10,3,0,2,6,8,0,0,0)


Um das rechte Kind von Knoten 6 abzufragen guckst du einfach bei rk[6-1]. Da steht dann eine 8 - fertig. Mit dem linken genauso.

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 21:21 
doch das rechte funktioniert :D das linke eig auch aber eben nicht bei allen zahlen ..
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Di 15.11.11 21:27 
Nein, deine rechte-Kind-Funktion ist falsch. Dass sie in dem Beispiel funktioniert, liegt an dem Beispiel - generell funktioniert das nicht!

Du findest damit ein Kind des Knotens, hast aber keine Information darüber, ob es linkes oder rechtes Kind ist.

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 21:29 
hmm okee dankeschön für die hilfe aber hat mir nicht viel geholfen :)
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Delphi-Laie
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starhalf offtopic starofftopic star
Beiträge: 501
Erhaltene Danke: 29


Delphi 2-4
BeitragVerfasst: Mi 16.11.11 01:11 
user profile iconBtl hat folgendes geschrieben Zum zitierten Posting springen:
hmm okee dankeschön für die hilfe aber hat mir nicht viel geholfen :)


Das ist nicht verwunderlich. Mit Verlaub: Wer Pointer nicht kennt, ist mit AVL-Bäumen um mehrere Größenordnungen überfordert. Und ich spreche dabei keinesfalls von oben herab: Ich verstehe diese dynamischen Datenstrukturen (damit meine ich die AVL-Bäume, nicht die Pointer) nämlich auch bis heute nicht (bemühte mich allerdings auch nicht ernsthaft darum) und war deshalb heilfroh und dankbar, mit fremder Hilfe einen Algorithmus, der auf dieser Datenstruktur beruht, implementiert zu bekommen.


Zuletzt bearbeitet von Delphi-Laie am Do 17.11.11 20:20, insgesamt 1-mal bearbeitet
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Moderator
Beiträge: 8117
Erhaltene Danke: 250

Win XP, Win 7
D7 PE, RAD Studio 2009 Professional
BeitragVerfasst: Mi 16.11.11 11:17 
Wobei das Bild in der Aufgabe ja auch kein AVL-Baum ist. Wenn (wie eigentlich zur Veranschauung des Prinzips üblich) die Schlüssel und die Knotennummern übereinstimmen, dann ist das noch nicht einmal ein Suchbaum.

Das Ding in der Aufgabe ist einfach ein Baum, mit dem man aber nichts weiter anfangen kann - weder als Suchstruktur, noch als eine Art Priority-Queue.

_________________
Oel ngati kameie.
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 230
Erhaltene Danke: 17

WinXP und Win98SE
Delphi 6 pro, Delphi 2006 und Turbo Pascal 7
BeitragVerfasst: Do 17.11.11 19:24 
Moin Btl,
Gausi hat schon recht, ohne Pointer geht da nichts.

Hier aus meinem Archiv eine Möglichkeit in Turbo-Pascal 4.0 1990 mit BS DOS :wink:
ausblenden volle Höhe Delphi-Quelltext markieren
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
PROGRAM AVL_BAUMDEMONSTRATION;
USES CRT;
CONST MAX=3;
TYPE BAUMINHALT=STRING[MAX];
SEITE=(LEFT,NONE,RIGHT);
BAUMZEIGER=^KNOTEN;
KNOTEN=RECORD
INHALT:BAUMINHALT;
LINKS,RECHTS:BAUMZEIGER;
SCHIEFE:SEITE
END;
VAR BAUM,SBAUM:BAUMZEIGER;
EINGABE:BAUMINHALT;
AUSWAHL:CHAR;
FELD:BYTE;
ZUSTAND:BOOLEAN;
PROCEDURE AUSGABE(X:INTEGER);
BEGIN
GOTOXY(41,18);WRITE('Stichwort ');
CASE X OF
0 : WRITE('wurde nicht gefunden.');
1 : WRITE('wird eingetragen.');
2 : WRITE('wird geloescht.');
3 : WRITE('wurde gefunden.');
4 : WRITE('ist schon vorhanden')
END;
CLREOL;GOTOXY(1,24);WRITE('Weiter mit <RETURN>');READ;GOTOXY(1,24);CLREOL
END;
PROCEDURE ROT_R(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.LINKS;BAUM^.LINKS:=AST^.RECHTS;AST^.RECHTS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_L(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.RECHTS;BAUM^.RECHTS:=AST^.LINKS;AST^.LINKS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_LR(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.LINKS;AST2:=BAUM^.RECHTS;AST1^.RECHTS:=AST2^.LINKS;
AST2^.LINKS:=AST1;BAUM^.LINKS:=AST2^.RECHTS;AST2^.RECHTS:=BAUM;
IF AST2^.SCHIEFE=LEFT THEN BAUM^.SCHIEFE:=RIGHT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=RIGHT THEN AST1^.SCHIEFE:=LEFT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE ROT_RL(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.RECHTS;AST2:=BAUM^.LINKS;AST1^.LINKS:=AST2^.RECHTS;
AST2^.RECHTS:=AST1;BAUM^.RECHTS:=AST2^.LINKS;AST2^.LINKS:=BAUM;
IF AST2^.SCHIEFE=RIGHT THEN BAUM^.SCHIEFE:=LEFT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=LEFT THEN AST1^.SCHIEFE:=RIGHT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE EINFUEGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
PROCEDURE ERZEUGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
NEW(BAUM);GEWACHSEN:=TRUE;BAUM^.INHALT:=STICHWORT;AUSGABE(1);
WITH BAUM^ DO BEGIN LINKS:=NIL;RECHTS:=NIL;SCHIEFE:=NONE END
END;
PROCEDURE WEITER_LINKS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.LINKS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END;
NONE : BAUM^.SCHIEFE:=LEFT;
LEFT : BEGIN
IF BAUM^.LINKS^.SCHIEFE=LEFT THEN
BEGIN ROT_R(BAUM);BAUM^.RECHTS^.SCHIEFE:=NONE END
ELSE ROT_LR(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END
END
END;
PROCEDURE WEITER_RECHTS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.RECHTS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN
IF BAUM^.RECHTS^.SCHIEFE=RIGHT THEN
BEGIN ROT_L(BAUM);BAUM^.LINKS^.SCHIEFE:=NONE END
ELSE ROT_RL(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END;
NONE : BAUM^.SCHIEFE:=RIGHT;
LEFT : BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END
END
END;
BEGIN(* OF EINFUEGEN *)
IF BAUM=NIL THEN ERZEUGEN(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT>STICHWORT THEN WEITER_LINKS(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT<STICHWORT THEN WEITER_RECHTS(BAUM,STICHWORT,GEWACHSEN)
ELSE BEGIN AUSGABE(4);GEWACHSEN:=FALSE END (* SCHON VORHANDEN *)
END;(* OF EINFUEGEN *)
PROCEDURE LOESCHEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GESCHRUMPFT:BOOLEAN);
VAR KNOTEN:BAUMZEIGER;
PROCEDURE AUSGL_RECHTS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
LEFT : CASE BAUM^.LINKS^.SCHIEFE OF
LEFT : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.RECHTS^.SCHIEFE:=NONE
END;
NONE : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=RIGHT;BAUM^.RECHTS^.SCHIEFE:=LEFT;
GESCHRUMPFT:=FALSE
END;
RIGHT: BEGIN ROT_LR(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=LEFT;GESCHRUMPFT:=FALSE END;
RIGHT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE AUSGL_LINKS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
RIGHT : CASE BAUM^.RECHTS^.SCHIEFE OF
RIGHT : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.LINKS^.SCHIEFE:=NONE
END;
NONE : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=LEFT;BAUM^.LINKS^.SCHIEFE:=RIGHT;
GESCHRUMPFT:=FALSE
END;
LEFT: BEGIN ROT_RL(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=RIGHT;GESCHRUMPFT:=FALSE END;
LEFT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE KLEINSTEN_HOLEN(VAR ZWEIG:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
IF ZWEIG^.LINKS=NIL THEN
BEGIN
BAUM^.INHALT:=ZWEIG^.INHALT;KNOTEN:=ZWEIG;ZWEIG:=ZWEIG^.RECHTS;
GESCHRUMPFT:=TRUE
END
ELSE BEGIN
KLEINSTEN_HOLEN(ZWEIG^.LINKS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(ZWEIG,GESCHRUMPFT)
END
END;
PROCEDURE ENTFERNEN(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
KNOTEN:=BAUM;
IF BAUM^.RECHTS=NIL THEN BEGIN BAUM:=BAUM^.LINKS;GESCHRUMPFT:=TRUE END
ELSE IF BAUM^.LINKS=NIL THEN BEGIN BAUM:=BAUM^.RECHTS;GESCHRUMPFT:=TRUE END
ELSE BEGIN
KLEINSTEN_HOLEN(BAUM^.RECHTS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END;
DISPOSE(KNOTEN)
END;
BEGIN(* OF LOESCHEN *)
IF BAUM=NIL THEN BEGIN AUSGABE(0);GESCHRUMPFT:=FALSE END (* NICHT VORHANDEN *)
ELSE IF BAUM^.INHALT>STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.LINKS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(BAUM,GESCHRUMPFT)
END
ELSE IF BAUM^.INHALT<STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.RECHTS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END
ELSE BEGIN AUSGABE(2);ENTFERNEN(BAUM,GESCHRUMPFT) END (* WIRD GELOESCHT *)
END;(* OF LOESCHEN *)
PROCEDURE SUCHEN(TREE:BAUMZEIGER;VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT);
BEGIN
BAUM:=TREE;
IF BAUM=NIL THEN AUSGABE(0)
ELSE IF BAUM^.INHALT>STICHWORT THEN SUCHEN(BAUM^.LINKS,BAUM,STICHWORT)
ELSE IF BAUM^.INHALT<STICHWORT THEN SUCHEN(BAUM^.RECHTS,BAUM,STICHWORT)
ELSE AUSGABE(3)
END;
PROCEDURE LINIE(VON,BIS,ZEILE:INTEGER);
VAR I:INTEGER;
BEGIN
IF VON<BIS THEN FOR I:=VON TO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END
ELSE FOR I:=VON DOWNTO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END;
GOTOXY(BIS,ZEILE+1);WRITE('I')
END;
PROCEDURE KOPF;
BEGIN
CLRSCR;
WRITELN('Demonstration eines AVL-Baumes':58);
WRITELN('------------------------------':58)
END;
PROCEDURE SCHREIBBAUM(B:BAUMZEIGER;X,Y,BREITE:INTEGER);
VAR H:BYTE;
BEGIN
IF B<>NIL THEN
BEGIN
IF B^.LINKS<>NIL THEN BEGIN
LINIE(X-FELD+1,X-BREITE DIV 2,Y);
SCHREIBBAUM(B^.LINKS,X-BREITE DIV 2,Y+2,BREITE DIV 2)
END;
GOTOXY(X-FELD DIV 2,Y);WRITE(COPY(B^.INHALT,1,FELD));
IF B^.RECHTS<>NIL THEN BEGIN
H:=0;IF FELD=1 THEN H:=1;
LINIE(X+FELD-1+H,X+BREITE DIV 2,Y);
SCHREIBBAUM(B^.RECHTS,X+BREITE DIV 2,Y+2,BREITE DIV 2)
END
END
END;
PROCEDURE PREORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
WRITE(B^.INHALT:FELD+1);PREORDER(B^.LINKS);PREORDER(B^.RECHTS)
END
END;
PROCEDURE INORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
INORDER(B^.LINKS);WRITE(B^.INHALT:FELD+1);INORDER(B^.RECHTS)
END
END;
PROCEDURE POSTORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
POSTORDER(B^.LINKS);POSTORDER(B^.RECHTS);WRITE(B^.INHALT:FELD+1)
END
END;
BEGIN(* OF MAIN *)
CLRSCR;
REPEAT
WRITE('MAXIMALE EINGABELAENGE (1-',MAX:1,') ? ');READLN(FELD)
UNTIL FELD IN[1..MAX];
KOPF;BAUM:=NIL;
REPEAT
GOTOXY(1,23);CLREOL;GOTOXY(1,23);
WRITE('(E)infgen (L)”schen (S)uchen (Q)uit : ');CLREOL;
REPEAT
AUSWAHL:=UPCASE(READKEY)
UNTIL AUSWAHL IN['E','L','S','Q'];WRITELN(AUSWAHL);
IF AUSWAHL<>'Q' THEN
BEGIN
REPEAT
GOTOXY(1,24);CLREOL;GOTOXY(1,24);
WRITE('Dein Begriff : ');READLN(EINGABE)
UNTIL LENGTH(EINGABE)>0;
EINGABE:=COPY(EINGABE,1,FELD);
CASE AUSWAHL OF
'E': BEGIN EINFUEGEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40) END;
'L': BEGIN LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40) END;
'S': BEGIN
SUCHEN(BAUM,SBAUM,EINGABE);KOPF;
IF SBAUM<>NIL THEN SCHREIBBAUM(SBAUM,40,5,40)
END
END;
GOTOXY(20,24);WRITE('Weiter mit <ENTER>');READLN;GOTOXY(1,24);CLREOL;
SCHREIBBAUM(BAUM,40,5,40);
GOTOXY(1,16);WRITE('Preorder :');PREORDER(BAUM);
GOTOXY(1,18);WRITE('Inorder :');INORDER(BAUM);
GOTOXY(1,20);WRITE('Postorder :');POSTORDER(BAUM)
END
UNTIL AUSWAHL='Q'
END.

Gruß
Fiete

_________________
Fietes Gesetz: use your brain (THINK)
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 230
Erhaltene Danke: 17

WinXP und Win98SE
Delphi 6 pro, Delphi 2006 und Turbo Pascal 7
BeitragVerfasst: Do 17.11.11 19:25 
Moin Btl,
Gausi hat schon recht, ohne Pointer geht da nichts.

Hier aus meinem Archiv eine Möglichkeit in Turbo-Pascal 4.0 1990 mit BS DOS :wink:
ausblenden volle Höhe Delphi-Quelltext markieren
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
PROGRAM AVL_BAUMDEMONSTRATION;
USES CRT;
CONST MAX=3;
TYPE BAUMINHALT=STRING[MAX];
SEITE=(LEFT,NONE,RIGHT);
BAUMZEIGER=^KNOTEN;
KNOTEN=RECORD
INHALT:BAUMINHALT;
LINKS,RECHTS:BAUMZEIGER;
SCHIEFE:SEITE
END;
VAR BAUM,SBAUM:BAUMZEIGER;
EINGABE:BAUMINHALT;
AUSWAHL:CHAR;
FELD:BYTE;
ZUSTAND:BOOLEAN;
PROCEDURE AUSGABE(X:INTEGER);
BEGIN
GOTOXY(41,18);WRITE('Stichwort ');
CASE X OF
0 : WRITE('wurde nicht gefunden.');
1 : WRITE('wird eingetragen.');
2 : WRITE('wird geloescht.');
3 : WRITE('wurde gefunden.');
4 : WRITE('ist schon vorhanden')
END;
CLREOL;GOTOXY(1,24);WRITE('Weiter mit <RETURN>');READ;GOTOXY(1,24);CLREOL
END;
PROCEDURE ROT_R(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.LINKS;BAUM^.LINKS:=AST^.RECHTS;AST^.RECHTS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_L(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.RECHTS;BAUM^.RECHTS:=AST^.LINKS;AST^.LINKS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_LR(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.LINKS;AST2:=BAUM^.RECHTS;AST1^.RECHTS:=AST2^.LINKS;
AST2^.LINKS:=AST1;BAUM^.LINKS:=AST2^.RECHTS;AST2^.RECHTS:=BAUM;
IF AST2^.SCHIEFE=LEFT THEN BAUM^.SCHIEFE:=RIGHT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=RIGHT THEN AST1^.SCHIEFE:=LEFT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE ROT_RL(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.RECHTS;AST2:=BAUM^.LINKS;AST1^.LINKS:=AST2^.RECHTS;
AST2^.RECHTS:=AST1;BAUM^.RECHTS:=AST2^.LINKS;AST2^.LINKS:=BAUM;
IF AST2^.SCHIEFE=RIGHT THEN BAUM^.SCHIEFE:=LEFT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=LEFT THEN AST1^.SCHIEFE:=RIGHT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE EINFUEGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
PROCEDURE ERZEUGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
NEW(BAUM);GEWACHSEN:=TRUE;BAUM^.INHALT:=STICHWORT;AUSGABE(1);
WITH BAUM^ DO BEGIN LINKS:=NIL;RECHTS:=NIL;SCHIEFE:=NONE END
END;
PROCEDURE WEITER_LINKS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.LINKS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END;
NONE : BAUM^.SCHIEFE:=LEFT;
LEFT : BEGIN
IF BAUM^.LINKS^.SCHIEFE=LEFT THEN
BEGIN ROT_R(BAUM);BAUM^.RECHTS^.SCHIEFE:=NONE END
ELSE ROT_LR(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END
END
END;
PROCEDURE WEITER_RECHTS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.RECHTS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN
IF BAUM^.RECHTS^.SCHIEFE=RIGHT THEN
BEGIN ROT_L(BAUM);BAUM^.LINKS^.SCHIEFE:=NONE END
ELSE ROT_RL(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END;
NONE : BAUM^.SCHIEFE:=RIGHT;
LEFT : BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END
END
END;
BEGIN(* OF EINFUEGEN *)
IF BAUM=NIL THEN ERZEUGEN(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT>STICHWORT THEN WEITER_LINKS(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT<STICHWORT THEN WEITER_RECHTS(BAUM,STICHWORT,GEWACHSEN)
ELSE BEGIN AUSGABE(4);GEWACHSEN:=FALSE END (* SCHON VORHANDEN *)
END;(* OF EINFUEGEN *)
PROCEDURE LOESCHEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GESCHRUMPFT:BOOLEAN);
VAR KNOTEN:BAUMZEIGER;
PROCEDURE AUSGL_RECHTS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
LEFT : CASE BAUM^.LINKS^.SCHIEFE OF
LEFT : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.RECHTS^.SCHIEFE:=NONE
END;
NONE : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=RIGHT;BAUM^.RECHTS^.SCHIEFE:=LEFT;
GESCHRUMPFT:=FALSE
END;
RIGHT: BEGIN ROT_LR(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=LEFT;GESCHRUMPFT:=FALSE END;
RIGHT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE AUSGL_LINKS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
RIGHT : CASE BAUM^.RECHTS^.SCHIEFE OF
RIGHT : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.LINKS^.SCHIEFE:=NONE
END;
NONE : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=LEFT;BAUM^.LINKS^.SCHIEFE:=RIGHT;
GESCHRUMPFT:=FALSE
END;
LEFT: BEGIN ROT_RL(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=RIGHT;GESCHRUMPFT:=FALSE END;
LEFT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE KLEINSTEN_HOLEN(VAR ZWEIG:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
IF ZWEIG^.LINKS=NIL THEN
BEGIN
BAUM^.INHALT:=ZWEIG^.INHALT;KNOTEN:=ZWEIG;ZWEIG:=ZWEIG^.RECHTS;
GESCHRUMPFT:=TRUE
END
ELSE BEGIN
KLEINSTEN_HOLEN(ZWEIG^.LINKS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(ZWEIG,GESCHRUMPFT)
END
END;
PROCEDURE ENTFERNEN(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
KNOTEN:=BAUM;
IF BAUM^.RECHTS=NIL THEN BEGIN BAUM:=BAUM^.LINKS;GESCHRUMPFT:=TRUE END
ELSE IF BAUM^.LINKS=NIL THEN BEGIN BAUM:=BAUM^.RECHTS;GESCHRUMPFT:=TRUE END
ELSE BEGIN
KLEINSTEN_HOLEN(BAUM^.RECHTS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END;
DISPOSE(KNOTEN)
END;
BEGIN(* OF LOESCHEN *)
IF BAUM=NIL THEN BEGIN AUSGABE(0);GESCHRUMPFT:=FALSE END (* NICHT VORHANDEN *)
ELSE IF BAUM^.INHALT>STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.LINKS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(BAUM,GESCHRUMPFT)
END
ELSE IF BAUM^.INHALT<STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.RECHTS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END
ELSE BEGIN AUSGABE(2);ENTFERNEN(BAUM,GESCHRUMPFT) END (* WIRD GELOESCHT *)
END;(* OF LOESCHEN *)
PROCEDURE SUCHEN(TREE:BAUMZEIGER;VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT);
BEGIN
BAUM:=TREE;
IF BAUM=NIL THEN AUSGABE(0)
ELSE IF BAUM^.INHALT>STICHWORT THEN SUCHEN(BAUM^.LINKS,BAUM,STICHWORT)
ELSE IF BAUM^.INHALT<STICHWORT THEN SUCHEN(BAUM^.RECHTS,BAUM,STICHWORT)
ELSE AUSGABE(3)
END;
PROCEDURE LINIE(VON,BIS,ZEILE:INTEGER);
VAR I:INTEGER;
BEGIN
IF VON<BIS THEN FOR I:=VON TO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END
ELSE FOR I:=VON DOWNTO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END;
GOTOXY(BIS,ZEILE+1);WRITE('I')
END;
PROCEDURE KOPF;
BEGIN
CLRSCR;
WRITELN('Demonstration eines AVL-Baumes':58);
WRITELN('------------------------------':58)
END;
PROCEDURE SCHREIBBAUM(B:BAUMZEIGER;X,Y,BREITE:INTEGER);
VAR H:BYTE;
BEGIN
IF B<>NIL THEN
BEGIN
IF B^.LINKS<>NIL THEN BEGIN
LINIE(X-FELD+1,X-BREITE DIV 2,Y);
SCHREIBBAUM(B^.LINKS,X-BREITE DIV 2,Y+2,BREITE DIV 2)
END;
GOTOXY(X-FELD DIV 2,Y);WRITE(COPY(B^.INHALT,1,FELD));
IF B^.RECHTS<>NIL THEN BEGIN
H:=0;IF FELD=1 THEN H:=1;
LINIE(X+FELD-1+H,X+BREITE DIV 2,Y);
SCHREIBBAUM(B^.RECHTS,X+BREITE DIV 2,Y+2,BREITE DIV 2)
END
END
END;
PROCEDURE PREORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
WRITE(B^.INHALT:FELD+1);PREORDER(B^.LINKS);PREORDER(B^.RECHTS)
END
END;
PROCEDURE INORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
INORDER(B^.LINKS);WRITE(B^.INHALT:FELD+1);INORDER(B^.RECHTS)
END
END;
PROCEDURE POSTORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
POSTORDER(B^.LINKS);POSTORDER(B^.RECHTS);WRITE(B^.INHALT:FELD+1)
END
END;
BEGIN(* OF MAIN *)
CLRSCR;
REPEAT
WRITE('MAXIMALE EINGABELAENGE (1-',MAX:1,') ? ');READLN(FELD)
UNTIL FELD IN[1..MAX];
KOPF;BAUM:=NIL;
REPEAT
GOTOXY(1,23);CLREOL;GOTOXY(1,23);
WRITE('(E)infgen (L)”schen (S)uchen (Q)uit : ');CLREOL;
REPEAT
AUSWAHL:=UPCASE(READKEY)
UNTIL AUSWAHL IN['E','L','S','Q'];WRITELN(AUSWAHL);
IF AUSWAHL<>'Q' THEN
BEGIN
REPEAT
GOTOXY(1,24);CLREOL;GOTOXY(1,24);
WRITE('Dein Begriff : ');READLN(EINGABE)
UNTIL LENGTH(EINGABE)>0;
EINGABE:=COPY(EINGABE,1,FELD);
CASE AUSWAHL OF
'E': BEGIN EINFUEGEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40) END;
'L': BEGIN LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40) END;
'S': BEGIN
SUCHEN(BAUM,SBAUM,EINGABE);KOPF;
IF SBAUM<>NIL THEN SCHREIBBAUM(SBAUM,40,5,40)
END
END;
GOTOXY(20,24);WRITE('Weiter mit <ENTER>');READLN;GOTOXY(1,24);CLREOL;
SCHREIBBAUM(BAUM,40,5,40);
GOTOXY(1,16);WRITE('Preorder :');PREORDER(BAUM);
GOTOXY(1,18);WRITE('Inorder :');INORDER(BAUM);
GOTOXY(1,20);WRITE('Postorder :');POSTORDER(BAUM)
END
UNTIL AUSWAHL='Q'
END.

Gruß
Fiete

_________________
Fietes Gesetz: use your brain (THINK)
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 979
Erhaltene Danke: 124

XP - Server 2008R2
D2 - Delphi XE
BeitragVerfasst: Do 17.11.11 19:40 
@Fiete

DRY ;-)

_________________
Das Problem liegt üblicherweise zwischen den Ohren
DRY DRY KISS
 
Antworten mit Zitat Beitrag melden
Private Nachricht sendenPosting in privater Nachricht zitieren
home home