Бинарные деревья / DEREVO

unit Derevo;
INTERFACE



uses crt;
const
NilBT = nil;
type
BinT = ^Node;
Elem = char; {ЇаҐ¤бв ў«Ґ­ЁҐ ЎЁ­ а­®Ј® ¤ҐаҐў }
{вЁЇ Elem ®ЇЁб ­ ў GlobalBT}
Node = record {㧥«:}
Info: Elem; { ᮤҐа¦Ё¬®Ґ}
LSub: BinT; { «Ґў®Ґ Ї®¤¤ҐаҐў®}
RSub: BinT { Їа ў®Ґ Ї®¤¤ҐаҐў®}
end {Node};

var
st: string;
i,y,lenght:integer;
t,tt:text;

procedure Otkaz (n: Byte); {б®®ЎйҐ­Ёп ®Ў ®иЁЎЄ е}
function CreateBT: BinT; {ᮧ¤ ­ЁҐ Ѓ„}
function NullBT (t: BinT): Boolean; {Їа®ўҐаЄ  Їгбв® «Ё „Ѓ}
function RootBT (t: BinT): Elem; {§­ з ­ЁҐ Є®а­п Ѓ„}
function LeftBT (t: BinT): BinT; {«Ґў®Ґ Ї®¤¤ҐаҐў® Ѓ„}
function RightBT (t: BinT): BinT; {Їа ў®Ґ Ї®¤¤ҐаҐў® „Ѓ}
function ConsBT (e: Elem; LS, RS: BinT): BinT; {Є®­бвагЄв®а ¤ҐаҐў }
procedure DestroyBT (var b: BinT); {г¤ «Ґ­ЁҐ ¤ҐаҐў }
procedure WriteBT (D : BinT); {ўлў®¤ ¤ҐаҐў  ў бЄ®Ў ЇаҐ¤бв ў«Ґ­ЁЁ ­  нЄа ­}
procedure WriteBT1 (D : BinT); {ўлў®¤ ¤ҐаҐў  ў бЄ®Ў ЇаҐ¤бв ў«Ґ­ЁЁ ў д ©«}
function Ent : BinT; {ўў®¤ ¤ҐаҐў  Ё§ д ©« }
procedure DisplayBT1 (b: BinT; n: integer); {ўлў®¤ ЇҐаҐў Ё§®Ўа ¤ҐаҐў  ­  нЄа ­}
procedure DisplayBT2 (b: BinT; n: integer); {ўлў®¤ ЇҐаҐў Ё§®Ўа ¤ҐаҐў  ў д ©«}


{ ---------------------------------------------------------------------------------}

IMPLEMENTATION
procedure Otkaz (n: Byte);
begin
Case n of
1: Write ('Ћ’ЉЂ‡: RootBT (Null_Bin_Tree)!');
2: Write ('Ћ’ЉЂ‡: LeftBT (Null_Bin_Tree)!');
3: Write ('Ћ’ЉЂ‡: RightBT (Null_Bin_Tree)!');
4: Write ('Ћ’ЉЂ‡: ЁбзҐаЇ ­  Ї ¬пвм!')
else Write ('Ћ’ЉЂ‡: ?')
end;
Halt
end {Otkaz};


function CreateBT: BinT;
begin
CreateBT := nil
end {CreateBT};

function NullBT (t: BinT): Boolean;
begin
NullBT := (t = nil)
end {NullBT};

function RootBT (t: BinT): Elem;
begin
if t <> nil then RootBT := t^.Info else Otkaz(1)
end {RootBT};

function LeftBT (t: BinT): BinT;
begin
if t <> nil then LeftBT := t^.LSub else Otkaz(2)
end {LeftBT};

function RightBT (t: BinT): BinT;
begin
if t <> nil then RightBT := t^.RSub else Otkaz(3)
end {RightBT};

function ConsBT (e: Elem; LS, RS: BinT): BinT;
var b: BinT;
begin
if MaxAvail >= SizeOf (Node) then
begin
New (b);
b^.Info:= e;
b^.LSub:= LS;
b^.RSub:= RS;
ConsBT:= b
end
else
Otkaz(4)
end {ConsBT};

procedure DestroyBT(var b: BinT);
begin
if b <> nil then
begin
DestroyBt (b^.LSub);
DestroyBt (b^.RSub);
Dispose (b)
end
end {DestroyBT};


procedure WriteBT (D : BinT);
begin
write('(');
write(rootBT(D));
if (LeftBT(D) = nil) then write('0') else WriteBT(LeftBT(D));
if (RightBT(D) = nil) then write('0') else WriteBT(RightBT(D));
write(')');
end;

procedure WriteBT1 (D : BinT);
begin
write(tt,'(');
write(tt,rootBT(D));
if (LeftBT(D) = nil) then write(tt,'0') else WriteBT1(LeftBT(D));
if (RightBT(D) = nil) then write(tt,'0') else WriteBT1(RightBT(D));
write(tt,')');
end;


function Ent : BinT;
var
c : char;
begin
c := st[lenght]; inc(lenght);
if (c = '(') then
begin
c := st[lenght]; inc(lenght);
end;
if (c <> '(') and (c <> ')') then if (c = '0') then Ent := nil else
begin
Ent := ConsBT(c,Ent,Ent);
c := st[lenght]; inc(lenght);
end;
end;


procedure DisplayBT1 (b: BinT; n: integer);
{ўлў®¤ Ї®бва®з­®Ј® Ё Ї®ўҐа­гв®Ј® Ё§®Ўа ¦Ґ­Ёп ЎЁ­ а­®Ј® ¤ҐаҐў  ЎҐ§ ў®§ўа в  Є аҐвЄЁ}
{n га®ўҐ­м 㧫 }
var i: integer;
begin
if NullBT (b) then {Writeln}
else
begin
Write (' ', RootBT (b));
if NullBT (RightBT (b))
then Writeln {ў­Ё§}
else DisplayBT1 (RightBT (b), n+1);
if not NullBT (LeftBT (b)) then
begin
for i := 1 to n do Write (' '); {ўЇа ў®}
DisplayBT1 (LeftBT (b), n+1);
end;
end;
end; {DisplayBT1}


procedure DisplayBT2 (b: BinT; n: integer);
{ўлў®¤ Ї®бва®з­®Ј® Ё Ї®ўҐа­гв®Ј® Ё§®Ўа ¦Ґ­Ёп ЎЁ­ а­®Ј® ¤ҐаҐў  ЎҐ§ ў®§ўа в  Є аҐвЄЁ}
{n га®ўҐ­м 㧫 }
var i: integer;
begin
if NullBT (b) then {Writeln}
else
begin
Write (tt,' ', RootBT (b));
if NullBT (RightBT (b))
then Writeln(tt) {ў­Ё§}
else DisplayBT2 (RightBT (b), n+1);
if not NullBT (LeftBT (b)) then
begin
for i := 1 to n do Write (tt,' '); {ўЇа ў®}
DisplayBT2 (LeftBT (b), n+1);
end;
end;
end; {DisplayBT2}


end.