Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Бинарные деревья / DEREVO2
.PASunit Derevo2;
INTERFACE
uses crt;
const
ForLen = 50;
NilT = nil;
type
Tree = ^tNode;
Forest = array [1..ForLen] of Tree; {«Ґб}
Elem = char; {ЇаҐ¤бв ў«ҐЁҐ ЎЁ а®Ј® ¤ҐаҐў }
{вЁЇ Elem ®ЇЁб ў GlobalT}
tNode = record {㧥«:}
Info: Elem; { ᮤҐа¦Ё¬®Ґ}
Sub1: Tree;
Sub2: Tree;
Sub3: Tree;
Sub4: Tree;
Sub5: Tree;
end {Node};
var
st1: string;
i1,y1,lenght1:integer;
t,tt:text;
procedure Otkaz (n: Byte); {б®®ЎйҐЁп ®Ў ®иЁЎЄ е}
function CreateT: Tree; {ᮧ¤ ЁҐ Ѓ„}
function NullT (t: Tree): Boolean; {Їа®ўҐаЄ Їгбв® «Ё „Ѓ}
function RootT (t: Tree): Elem; {§ з ЁҐ Є®ап Ѓ„}
function T1 (t: Tree): Tree;
function T2 (t: Tree): Tree;
function T3 (t: Tree): Tree;
function T4 (t: Tree): Tree;
function T5 (t: Tree): Tree;
function Cons_T (e: Elem; L1,L2,L3,L4,L5: Tree): Tree; {Є®бвагЄв®а ¤ҐаҐў }
procedure DestroyT (var b: Tree); {г¤ «ҐЁҐ ¤ҐаҐў }
procedure WriteT (D : Tree); {ўлў®¤ ¤ҐаҐў ў бЄ®Ў ЇаҐ¤бв ў«ҐЁЁ нЄа }
procedure WriteT1 (D : Tree;var tt:text); {ўлў®¤ ¤ҐаҐў ў бЄ®Ў ЇаҐ¤бв ў«ҐЁЁ ў д ©«}
function EnterT(s:string) : Tree; {ўў®¤ ¤ҐаҐў Ё§ д ©« }
procedure DisplayT1 (b: Tree; n,l: integer); {ўлў®¤ ЇҐаҐў Ё§®Ўа ¤ҐаҐў нЄа }
procedure DisplayT2 (b: Tree; n,l: integer;var tt:text); {ўлў®¤ ЇҐаҐў Ё§®Ўа ¤ҐаҐў нЄа }
procedure CreateForest(var F : forest); {ᮧ¤ ЁҐ «Ґб }
procedure Listin(T : Tree; var F:forest); {ў®§ўа й Ґв «Ґб Ї®¤¤ҐаҐўмҐў ¤ҐаҐў }
procedure Tail(T : Tree; var F,F1 : forest ); {ў®§ўа § Ґв «Ґб ¤ҐаҐў ЎҐ§ Ј®«®ўл}
function Head (F : forest):Tree; {ў®§ўа й Ґв Ј®«®ў®Ґ ¤ҐаҐў® «Ґб }
function NullF(F:forest):boolean; {Їа®ўҐаЄ Їгбв «Ё «Ґб}
{ ---------------------------------------------------------------------------------}
IMPLEMENTATION
procedure Otkaz (n: Byte);
begin
Case n of
1: Write ('Ћ’ЉЂ‡: RootT (Null_Bin_Tree)!');
2: Write ('Ћ’ЉЂ‡: LeftT (Null_Bin_Tree)!');
3: Write ('Ћ’ЉЂ‡: RightT (Null_Bin_Tree)!');
4: Write ('Ћ’ЉЂ‡: ЁбзҐаЇ Ї ¬пвм!')
else Write ('Ћ’ЉЂ‡: ?')
end;
Halt
end {Otkaz};
function CreateT: Tree;
begin
CreateT := nil
end {CreateT};
function NullT (t: Tree): Boolean;
begin
NullT := (t = nil)
end {NullT};
function RootT (t: Tree): Elem;
begin
if t <> nil then RootT := t^.Info else Otkaz(1)
end {RootT};
function T1 (t: Tree): Tree;
begin
if t <> nil then T1 := t^.Sub1 else Otkaz(2)
end {T1};
function T2 (t: Tree): Tree;
begin
if t <> nil then T2 := t^.Sub2 else Otkaz(2)
end {T2};
function T3 (t: Tree): Tree;
begin
if t <> nil then T3 := t^.Sub3 else Otkaz(2)
end {T3};
function T4 (t: Tree): Tree;
begin
if t <> nil then T4 := t^.Sub4 else Otkaz(2)
end {T4};
function T5 (t: Tree): Tree;
begin
if t <> nil then T5 := t^.Sub5 else Otkaz(2)
end {T5};
function Cons_T (e: Elem; L1, L2, L3, L4, L5: Tree): Tree;
var b: Tree;
begin
if MaxAvail >= SizeOf (tNode) then
begin
New (b);
b^.Info:= e;
b^.Sub1:= L1;
b^.Sub2:= L2;
b^.Sub3:= L3;
b^.Sub4:= L4;
b^.Sub5:= L5;
Cons_T:= b
end
else
Otkaz(4)
end {Cons_T};
procedure DestroyT(var b: Tree);
begin
if b <> nil then
begin
DestroyT (b^.Sub1);
DestroyT (b^.Sub2);
DestroyT (b^.Sub3);
DestroyT (b^.Sub4);
DestroyT (b^.Sub5);
Dispose (b)
end
end {DestroyT};
procedure WriteT (D : Tree);
begin
write('(');
write(rootT(D));
if (T1(D) <> nil) then WriteT(T1(D));
if (T2(D) <> nil) then WriteT(T2(D));
if (T3(D) <> nil) then WriteT(T3(D));
if (T4(D) <> nil) then WriteT(T4(D));
if (T5(D) <> nil) then WriteT(T5(D));
write(')');
end;
procedure WriteT1 (D : Tree;var tt:text);
begin
write(tt,'(');
write(tt,rootT(D));
if (T1(D) <> nil) then WriteT1(T1(D),tt);
if (T2(D) <> nil) then WriteT1(T2(D),tt);
if (T3(D) <> nil) then WriteT1(T3(D),tt);
if (T4(D) <> nil) then WriteT1(T4(D),tt);
if (T5(D) <> nil) then WriteT1(T5(D),tt);
write(tt,')');
end;
function EnterT(s:string) : Tree;
var ll:integer;
rrr:tree;
function EntT : Tree;
var
c,temp : char;
begin
c := s[ll]; inc(ll);
{ write(c); readkey; }
if (c = '(') then
begin
c := s[ll]; inc(ll);
end;
{write(c); readkey;}
if (c = ')') then
begin
EntT := nil;
ll := ll -1
end else
begin
EntT := Cons_T(c,EntT,EntT,EntT,EntT,EntT);
c := s[ll]; inc(ll);
end;
end;
begin
ll:=1;
rrr:=entt;
entert := rrr;
end;
procedure DisplayT1 (b: Tree; n,l: integer);
{ўлў®¤ Ї®бва®з®Ј® Ё Ї®ўҐагв®Ј® Ё§®Ўа ¦ҐЁп ЎЁ а®Ј® ¤ҐаҐў ЎҐ§ ў®§ўа в Є аҐвЄЁ}
{n га®ўҐм 㧫 }
var i,j,k,r: integer;
begin
k:=1;
r:=1;
for j:=1 to n do k:=k+1;
k:=k+l;
if NullT (b) then {Writeln}
else
begin
for i:=1 to k do write(' ');
Write ({' ',} RootT (b)); writeln;
DisplayT1(T1(b),n+1,k);
DisplayT1(T2(b),n+1,k);
DisplayT1(T3(b),n+1,k);
DisplayT1(T4(b),n+1,k);
DisplayT1(T5(b),n+1,k);
{writeln;}
end;
end; {DisplayBT1}
procedure DisplayT2 (b: Tree; n,l: integer;var tt:text);
{ўлў®¤ Ї®бва®з®Ј® Ё Ї®ўҐагв®Ј® Ё§®Ўа ¦ҐЁп ЎЁ а®Ј® ¤ҐаҐў ЎҐ§ ў®§ўа в Є аҐвЄЁ}
{n га®ўҐм 㧫 }
var i,j,k,r: integer;
begin
k:=1;
r:=1;
for j:=1 to n do k:=k+1;
k:=k+l;
if NullT (b) then {Writeln}
else
begin
for i:=1 to k do write(tt,' ');
Write (tt,RootT(b)); writeln(tt);
DisplayT2(T1(b),n+1,k,tt);
DisplayT2(T2(b),n+1,k,tt);
DisplayT2(T3(b),n+1,k,tt);
DisplayT2(T4(b),n+1,k,tt);
DisplayT2(T5(b),n+1,k,tt);
{writeln;}
end;
end; {DisplayBT1}
procedure CreateForest(var F : forest);
var t : integer;
begin
for t := 1 to ForLen do F[t] := nil;
end;
procedure Listin(T : Tree; var F:forest);
begin
CreateForest(F);
F[2] := T2(T);
F[1] := T1(T);
F[3] := T3(T);
F[4] := T4(T);
F[5] := T5(T);
end; {Listing}
procedure Tail(T : Tree; var F,F1 : forest );
var n : integer;
begin
CreateForest(F1);
for n := 1 to ForLen do
begin
if (F[n] <> T) then F1[n] := F[n];
end;
end;
function Head (F : forest):Tree;
var
n : integer;
begin
n:=1;
while ( (nullT(F[n])) and (n <= ForLen)) do inc(n);
if (n=ForLen + 1) then Head := nil else Head := F[n];
end; {Tail}
function NullF(F:forest):boolean;
var n : integer;
begin
n:=1;
while ( (nullT(F[n])) and (n <= ForLen)) do inc(n);
if (n=ForLen + 1) then NullF := true else NullF := false;
end;
end.
Соседние файлы в папке Бинарные деревья