Бинарные деревья на языке Паскаль / BINTREE

{ Њ®¤г«м ¤«п а Ў®вл б ЎЁ­ а­л¬Ё ¤ҐаҐўмп¬Ё }
Unit BinTree;
INTERFACE
uses GlobalBT;
const
NilBT=nil;
type
BinT=^Node; { ЇаҐ¤бв ў«Ґ­ЁҐ ЎЁ­ а­®Ј® ¤ҐаҐў  }
{ вЁЇ Elem ®ЇЁб ­ ў ¬®¤г«Ґ GlobalBT }
Node=record { 㧥«: }
Info:Elem; { = ᮤҐа¦Ё¬®Ґ }
LSub:BinT; { = «Ґў®Ґ Ї®¤¤ҐаҐў® }
RSub:BinT; { = Їа ў®Ґ Ї®¤¤ҐаҐў® }
end;{ Node }

function CreateBt :BinT;
{ ᮧ¤ вм Їгб⮥ ¤ҐаҐў®}
function NullBT ( t:BinT ) :Boolean;
{Їа®ўҐаЁвм ¤ҐаҐў® ­  Їгбв®вг}
function RootBT ( t:BinT ) :Elem;
{ўл¤Ґ«Ёвм Є®аҐ­м ¤ҐаҐў 
®вЄ § - Null
Pred: not Null(t) }
function LeftBT ( t:BinT ) :BinT;
{ўл¤Ґ«Ёвм «Ґў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - Null
Pred: not Null(t) }
function RightBT ( t:BinT ) :BinT;
{ўл¤Ґ«Ёвм Їа ў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - Null
Pred: not Null(t) }
function ConsBT ( e:Elem; LS,RS :BinT ) :BinT;
{Є®­бвагЄв®а
®вЄ § - ­Ґ еў в Ґв Ї ¬пвЁ ¤«п ­®ў®Ј® н«Ґ¬Ґ­в }
procedure DestroyBT ( var b: BinT);
{®зЁбвЁвм Ї ¬пвм § ­Ё¬ Ґ¬го н«Ґ¬Ґ­в ¬Ё ¤ҐаҐў }
procedure Otkaz ( n : Byte );
{ўлўҐбвЁ б®®ЎйҐ­ЁҐ ЇаЁ Ї®ЇлвЄҐ ўлЇ®«­Ґ­Ёп
­Ґ¤®ЇгбвЁ¬ле ®ЇҐа жЁ© Ё § ўҐаиЁвм а Ў®вг Їа®Ја ¬¬л}
{-------------------------------------------------------------------------}
function MakeRoot ( e :Elem ) :BinT;
{ᮧ¤ вм Є®аҐ­м ¤ҐаҐў 
®вЄ § - ­Ґ еў в Ґв Ї ¬пвЁ ¤«п ­®ў®Ј® н«Ґ¬Ґ­в }
procedure SetLeft ( e :Elem; b:BinT );
{Ї®¤ўҐбЁвм ­®ўл© 㧥« ў «Ґў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - not Null, Null(LeftBT)
Pred: ( not Null(t) ) & ( Null( LeftBT(t) ) )}
procedure SetRight ( e :Elem; b:BinT );
{Ї®¤ўҐбЁвм ­®ўл© 㧥« ў Їа ў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - not Null, Null(RightBT)
Pred: ( not Null(t) ) & ( Null( RightBT(t) ) )}
{-------------------------------------------------------------------------}
IMPLEMENTATION

procedure Otkaz ( n : Byte );
{ ўлўҐбвЁ б®®ЎйҐ­ЁҐ ЇаЁ Ї®ЇлвЄҐ ўлЇ®«­Ґ­Ёп
­Ґ¤®ЇгбвЁ¬ле ®ЇҐа жЁ© Ё § ўҐаиЁвм а Ў®вг Їа®Ја ¬¬л }
begin
Writeln;
Case n of
1 : Writeln( 'Ћ’ЉЂ‡ : RootBT( Null_Bin_Tree ) !');
2 : Writeln( 'Ћ’ЉЂ‡ : LeftBT( Null_Bin_Tree ) !');
3 : Writeln( 'Ћ’ЉЂ‡ : RightBT( Null_Bin_Tree ) !');
4 : Writeln( 'Ћ’ЉЂ‡ : ЁбзҐаЇ ­  Ї ¬пвм !');
5 : Writeln( 'Ћ’ЉЂ‡ : SetLeft( Null_Bin_Tree )');
6 : Writeln( 'Ћ’ЉЂ‡ : SetLeft( Not ( Null_Bin_Tree ( LeftBT ) ) )');
7 : Writeln( 'Ћ’ЉЂ‡ : SetRight( Null_Bin_Tree )');
8 : Writeln( 'Ћ’ЉЂ‡ : SetRight( Not ( Null_Bin_Tree ( RightBT ) ) )');
else Writeln( 'Ћ’ЉЂ‡ : ?');
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;
{ўл¤Ґ«Ёвм Є®аҐ­м ¤ҐаҐў 
®вЄ § - Null}
begin
if t <> nil then RootBT:=t^.Info else Otkaz(1);
end{ RootBT };

function LeftBT ( t:BinT ) :BinT;
{ўл¤Ґ«Ёвм «Ґў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - Null}
begin
if t <> nil then LeftBT:=t^.LSub else Otkaz(2);
end{ LeftBT };

function RightBT ( t:BinT ) :BinT;
{ўл¤Ґ«Ёвм Їа ў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - Null}
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 };

{----------------„®Ї®«­ЁвҐ«м­лҐ дг­ЄжЁЁ-----------------------------------}
function MakeRoot ( e :Elem ) :BinT;
{ ᮧ¤ вм Є®аҐ­м ¤ҐаҐў 
®вЄ § - ­Ґ еў в Ґв Ї ¬пвЁ ¤«п ­®ў®Ј® н«Ґ¬Ґ­в }
var b :BinT;
begin
if MaxAvail >= SizeOf(Node) then
begin
New( b );
b^.Info:=e; b^.LSub:=nil; b^.RSub:=nil;
MakeRoot:=b;
end
else Otkaz(4);
end{ MakeRoot };

procedure SetLeft ( e :Elem; b:BinT );
{ Ї®¤ўҐбЁвм ­®ўл© 㧥« ў «Ґў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - not Null, not Null(LeftBT) }
begin
if NullBT( b ) then Otkaz( 5 )
else if NullBT( LeftBT( b ) ) then b^.LSub:=MakeRoot(e)
else Otkaz(6);
end{ SetLeft };

procedure SetRight ( e :Elem; b:BinT );
{ Ї®¤ўҐбЁвм ­®ўл© 㧥« ў Їа ў®Ґ Ї®¤¤ҐаҐў®
®вЄ § - not Null, not Null(RightBT) }
begin
if NullBT( b ) then Otkaz( 7 )
else if NullBT( RightBT( b ) ) then b^.RSub:=MakeRoot(e)
else Otkaz(8);
end{ SetRight };

end.