Бинарные деревья на языке Паскаль / 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.