Файловый архив студентов. Файловый архив студентов.
1327 вузов, 5493 предметов.
/ Регистрация
FAQ Обратная связь Вопросы и предложения
Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Санкт-Петербургский государственный электротехнический университет "ЛЭТИ"
Предмет:
Программирование
Файл:

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

.PAS
Скачиваний:
11
Добавлен:
01.05.2014
Размер:
7 Кб
Скачать
☆ 
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.
Соседние файлы в папке Бинарные деревья
Помощь Обратная связь Вопросы и предложения Пользовательское соглашение Политика конфиденциальности