Методические материалы
по курсу
"Алгоритмы и алгоритмические языки"

(* BTrees : Программа построения и модификации дерева поиска.          *)
(*          Реализация в виде пригодном для использования в Интернет;  *)
(*          метод задания параметров - POST. >> >> pasweb.htm           *)
(*              перем.T : указатель на корень дерева.                  *)
(*                        Первоначально T = nil                        *)
(*          Программа получает от пользователя последовательность      *)
(*          целых чисел ISQ[1..N] и обрабатывает ее по следующим       *)
(*          правилам  (K = ISQ[I]) :                                   *)
(* Если 0 < K <= 999  , то включть в T вершину с ключом K.       Form  *)
(* Если     K = 0     , то проверить корректность T.             BT    *)
(* Если -999 <= K <  0, то удалить в T вершину с ключом abs(K).  Kill  *)
(* Если 1000 <= abs(K), то найти в T вершину с ключом            Find  *)
(*                                           abs(K) mod 1000.          *)
 
program BTrees;
 
const  MSQ = 200;
 
type    info = record inf : integer end;   (* Для определенности *)
     pRecord = ^info;
     pDoTree = ^DoTree;
      DoTree = record   Key : integer;  (* ключ *)
                       Left : pDoTree;  (* указатель на левое  поддерево *)
                      Right : pDoTree;  (* указатель на правое поддерево *)
                       REFF : pRecord;  (* ассоциированная информация    *)
               end;
 
var    ISQ : array [1..MSQ] of integer;
     I,K,N : integer;
       V,T : pDoTree;                    (* Дерево *)
 
(* IntSeq - ввод последовательности целых чисел ISQ[1..N] *)
 
procedure IntSeq(var N : integer);
   var K,R,Z : integer;
           A : char;
   procedure BISQ;
   begin   N:=N+1;                                   (* Вперед *)
           if (N <= MSQ) and (0 < K) then ISQ[N]:=R
                                     else N:=N-1;    (* Назад  *)
           K:=0; R:=0; Z:=1;
   end;
begin      K:=0; R:=0; Z:=1;
        N:=0;
        while not eoln do begin
           Read(A);
           if ('0' <= A) and (A <= '9') then begin
              R:=10*R+Z*(ord(A)-ord('0'));
              K:=K+1;
              if 1000 <= abs(R) then BISQ
           end                          else BISQ;
           if A = '-' then Z:=-1
        end;
        BISQ;
        Readln                                 end;
 
(* Find : поиск в дереве вершины с ключом K.                    *)

function Find(X : pDoTree; K : integer) : pDoTree;
begin    Find:=X;                                  (* D = nil / K = Key *)
             if X <> nil then with X^ do
             if  Key < K then Find:=Find(Right,K)
        else if  K < Key then Find:=Find(Left ,K)  end;

(* Form : включить в дерево D (новую) вершину с ключом K.       *)

function Form(var D : pDotree; K : integer) : pDoTree;
begin   if D = nil then begin
             new(D);                                  (* Построить новую вершину *)
                 D^.Key  :=K;
                 D^.Reff :=nil;
                 D^.Left :=nil;
                 D^.Right:=nil;
           Form:=D
        end;
        with D^ do
             if Key = K then Form:=D
        else if Key < K then Form:=Form(Right,K)
        else                 Form:=Form(Left ,K)  end;

(* Kill : удалить в дереве D вершину с ключом K.                *)

procedure Kill(var D : pDoTree; K : integer);
   var Q : pDoTree;
   procedure Ki(var D : pDotree);
   begin   if D^.Right <> nil then Ki(D^.Right) else begin
              Q^.Key :=D^.Key;
              Q^.Reff:=D^.Reff;
              Q:=D;
              D:=D^.Left
           end
   end;
begin   if D = nil then Exit;
        with D^ do
             if Key < K then Kill(Right,K)
        else if Key > K then Kill(Left ,K)
        else begin Q:=D;
                if Q^.Reff <> nil then Dispose(Q^.Reff);
                if  Left = nil then D:=Right      (* 1   *)
           else if Right = nil then D:=Left       (* 2   *)
           else                     Ki(Left);     (* 4   *)
           Dispose(Q)
        end                                            end;

(* BT  : функция проверки бинарных деревьев на                *)
(*       принадлежность классу деревьев поиска.               *)
 
function BTW(X : pDoTree; var Kmin,Kmax : integer) : boolean;
   var Lmin,Lmax,Rmin,Rmax : integer;
begin   BTW:=true;                     (* оптимистический подход *)
        with D^ do begin               (* NB. X <> nil *)
                if         Left  = nil      then Kmin:=Key
           else if not BTW(Left ,Lmin,Lmax) then  BTW:=false
           else if  Lmax < Key              then Kmin:=Lmin
           else                                   BTW:=false;
                if         Right = nil      then Kmax:=Key
           else if not BTW(Right,Rmin,Rmax) then  BTW:=false
           else if         Key < Rmin       then Kmax:=Rmax
           else                                   BTW:=false
        end                                              end;
 
function BT(X : pDoTree) : boolean;
   var Tmin,Tmax : integer;
begin   if X = nil then BT:=true
                   else BT:=BTW(X,Tmin,Tmax)   end;
 
(* List : Ввести на печать дерево X в скобочном виде         *)
 
procedure List(X : pDoTree);
begin   if   X = nil
        then write('nil')
        else with X^ do
             if (Left  = nil) and
                (Right = nil) then write('T',Key) else begin
                write('(T',Key,' '); List(Left);
                write(         ' '); List(Right); write(')')
             end                                         end;
 
begin   T:=nil;
        IntSeq(N);
        writeln('Content-type: text/html');
        writeln;
        writeln('<html><pre>');
        writeln(' ':17,'*** Программа BTrees ***');
        writeln;
        write('ISQ[1..':10,N:3,'] = ');
        for I:=1 to N do write(ISQ[I],' '); writeln;
        writeln('Начало. T = nil':20);
        writeln;
        for I:=1 to N do begin
           K:=ISQ[I];
                if      K = 0     then write('BT(T)= ':17,BT(T))
           else if 1000 <= abs(K) then begin
                   K:=abs(K) mod 1000;
                   write('Find(T,',K:3,')    = ');
                   List(Find(T,K))
                end
           else if      0 < K     then begin
                   write('Form(T,',K:3,'); T = ');
                   V:=Form(T,K);
                   with V^ do
                   if REFF = nil then begin
                      new(REFF);
                      REFF^.Inf:=I
                   end;
                   List(T)
                end
           else        (* K < 0 *)       begin
                   K:=abs(K);
                   write('Kill(T,',K:3,'); T = ');
                   Kill(T,K);
                   List(T)
                end;
           writeln;
        end;
        writeln;
        write('Результат. T = ':17); List(T); writeln;
        writeln;
        writeln('Конец.</pre></html>');
end.