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