Autor Beitrag
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
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
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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.

_________________
We are, we were and will not be.
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!
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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?

_________________
We are, we were and will not be.
Btl Threadstarter
Hält's aus hier
Beiträge: 7



BeitragVerfasst: Di 15.11.11 21:00 
ausblenden volle Höhe Delphi-Quelltext
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
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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:

_________________
We are, we were and will not be.
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 ?
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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
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.

_________________
We are, we were and will not be.
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 ..
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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.

_________________
We are, we were and will not be.
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 :)
Delphi-Laie
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 1600
Erhaltene Danke: 232


Delphi 2 - RAD-Studio 10.1 Berlin
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
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8548
Erhaltene Danke: 477

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
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.

_________________
We are, we were and will not be.
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 617
Erhaltene Danke: 364

W7
Delphi 6 pro
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
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,40END;
      'L'BEGIN  LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40END;
      '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)
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 617
Erhaltene Danke: 364

W7
Delphi 6 pro
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
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,40END;
      'L'BEGIN  LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BAUM,40,5,40END;
      '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)
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1248
Erhaltene Danke: 187

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

DRY ;-)

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS