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

uses crt;

const
NilBT = nil;
type
BinT = ^Node;
Elem = char; {ЇаҐ¤бв ў«Ґ­ЁҐ ЎЁ­ а­®Ј® ¤ҐаҐў }
{вЁЇ 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;
function LeftBT (t: BinT): BinT;
function RightBT (t: BinT): BinT;
function ConsBT (e: Elem; LS, RS: BinT): BinT;
procedure DestroyBT (var b: BinT);
procedure Otkaz (n: Byte);}
{ ---------------------------------------------------------------------------------}
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};
var

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

derevo1,derevo2,derevo3 : BinT;




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;




{-----------ANALIZATOR----------------}
Function TEST(S : string): boolean;
const
koren = ['a' .. 'z', 'A' .. 'Z'];
var
znach, itog, temp : boolean;
i, len : integer;
str : string;
cur : char;

procedure scan;
begin
if (i <= len) then
begin
cur := s[i];
inc(i);
end else
begin
cur := '!';
exit;
end;
end; {scan}

function TestBT : boolean;
forward;
function forest:boolean;
var znach : boolean;
begin
znach := true;
if s[i] = '(' then
begin
znach := testbt;
if znach then
begin
znach := forest;
end;
end;
forest := znach;
end;

function TestBT : boolean;
var znach : boolean;
begin
scan;
if (cur = '(') then
begin
scan;
znach := cur in koren;
if znach then
begin
znach := forest;
end;
scan;
if (cur <> ')') then
begin
znach := false;
end;
end else znach := false;
TestBT := znach;
end; {TestBT}
Begin
temp := false;
len := Length(s);
i := 1;
itog := TestBT;
itog := itog and (i <> len);
TEST := itog;
End; {TEST}
{--------END--ANALIZATOR--------------}



function Ent : BinT;
var
c : char;
begin
{read(t,c);}
c := st[lenght]; inc(lenght);
if (c = '(') then {read(t,c);}
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);
{read(t,c);}
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}


Function Go:BinT;
type Forest = array [1..20] of BinT; {«Ґб}
var
i,j,k,schet,num : integer;
F : Forest;
temp,o,tek : BinT;

function B(L,R:bint):bint;
begin
inc(y);
if ((nullBT(L)) and (nullBT(R))) {or (rootBT(L) = '0')} then B := nil else
begin
B := consBT(rootbt(L),B(LeftBT(L),RightBT(L)),B(R,nil));
end;
end; {B}

begin
schet := 1;
i := 1;
while not eof(t) do
begin
writeln(tt,'‘зЁвлў о ¤ҐаҐў® ­®¬Ґа ',schet,'...');
readln(t,st);
if TEST(st) then BEGIN
lenght := 1;
tek := Ent;
begin
writeln(tt,'„ҐаҐў® ­®¬Ґа ',schet,' бзЁв ­®. ‘Є®Ў®з­ п § ЇЁбм ¤ҐаҐў :');
WriteBT1(tek);
writeln(tt);
F[i] := tek;
inc(i);
end;

END else
begin
writeln('ЋиЁЎЄ  ў § ЇЁбЁ ¤ҐаҐў  ­®¬Ґа ',schet,'. „ҐаҐў® ­Ґ бзЁв ­®.');
writeln(tt,'ЋиЁЎЄ  ў § ЇЁбЁ ¤ҐаҐў  ­®¬Ґа ',schet,'. „ҐаҐў® ­Ґ бзЁв ­®.');
end;
inc(schet);
end;
dec(i);

writeln(tt,'ЋЎа Ў®вЄ  «Ґб ...');
if (i=1) then
begin
Temp := B(F[1],nil);
DestroyBT(F[1]);
end else BEGIN
for j := i downto 2 do
begin
Temp := B(F[j-1],F[j]);
DestroyBT(F[j-1]);
DestroyBT(F[j]);
F[j-1] := Temp;
end;
END;


Go := Temp;
writeln(tt,'Џ®«г祭® ЎЁ­ а­®Ґ ¤ҐаҐў® «Ґб :');
writeln('Џ®«г祭® ЎЁ­ а­®Ґ ¤ҐаҐў® «Ґб :');
DisplayBT1(Temp,1);
DisplayBT2(Temp,1);
writeln(tt);
writeln;
writeln('‘Є®Ў®з­®Ґ ЇаҐ¤бв ў«Ґ­ЁҐ ЎЁ­ а­®Ј® ¤ҐаҐў  «Ґб :');
writeln(tt,'‘Є®Ў®з­®Ґ ЇаҐ¤бв ў«Ґ­ЁҐ ЎЁ­ а­®Ј® ¤ҐаҐў  «Ґб :');
WriteBT(Temp);
WriteBT1(Temp);
end;{Go}


Begin
clrscr;
{y:=0;
assign(t,'der_in.txt'); reset(t);}
assign(tt,'1111111.pas'); reset(tt);
{go;
close(t);
close(tt);}
read(tt,ss);
write(test(ss));
readkey;

End.