АВЛ - деревья / AVLVECT

unit AVLvect;
interface
   uses crt;
   type
       elem=record
           val:integer;
           r,l:integer;
           hl,hr:integer;
           f:integer
           end;
       tree=record
           nom:array[1..100]of elem;
           kol:integer
           end;

   procedure create(var t:tree);
   procedure print1(var t:tree);
   procedure insert(x:integer;var t:tree);
   procedure reverseR(n:integer;var t:tree);
   procedure reverseL(n:integer;var t:tree);
   procedure otlad(var t:tree);
   procedure delete(x:integer;var t:tree);
   procedure print3(var t:tree);
implementation

   procedure print3(var t:tree);
   var i,put,x1,y1:integer;

   procedure print(x,y,n:integer;var tr:tree);
   begin
   gotoxy(x,y);
   write(tr.nom[n].val);
   if tr.nom[n].r<>0 then
      print(x+7,y+5,tr.nom[n].r,tr);
   if tr.nom[n].l<>0 then
      print(x-7,y+5,tr.nom[n].l,tr);
   end;

   begin
   i:=1;
   while t.nom[i].f<>0 do i:=i+1;
   put:=i;
   x1:=40;
   y1:=1;
   print(x1,y1,put,t);
   end;

   procedure print1(var t:tree);
   var i:integer;
   begin
   write('val: ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].val) end;
   writeln;
   write('r:   ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].r) end;
   writeln;
   write('l:   ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].l) end;
   writeln;
   write('hr:  ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].hr) end;
   writeln;
   write('hl:  ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].hl) end;
   writeln;
   write('f:   ');
   for i:=1 to t.kol do begin
   write(' ',t.nom[i].f) end;
   writeln;
   end;

   procedure create(var t:tree);
   var i:integer;
   begin
   t.kol:=0;
   for i:=1 to 100 do begin
   t.nom[i].val:=0;
   t.nom[i].r:=0;
   t.nom[i].l:=0;
   t.nom[i].hr:=0;
   t.nom[i].hl:=0;
   t.nom[i].f:=0;
   end;
   end;

   procedure insert(x:integer;var t:tree);
   var i,n,put,m:integer;
       prod:boolean;
   begin
   i:=1;
   while t.nom[i].f<>0 do i:=i+1;
   put:=i;
   m:=0;
   prod:=true;
   while put<>0 do begin
     if t.nom[put].val<x then begin m:=put;put:=t.nom[put].r end;
     if t.nom[put].val>x then begin m:=put;put:=t.nom[put].l end;
     if t.nom[put].val=x then begin put:=0;prod:=false end;
    end;

   if prod then begin
      t.kol:=t.kol+1;
      n:=t.kol;
      if n=1 then m:=0;
      t.nom[n].f:=m;
      t.nom[n].hl:=0;
      t.nom[n].hr:=0;
      t.nom[n].r:=0;
      t.nom[n].l:=0;
      t.nom[n].val:=x;
      if m<>0 then begin
         if t.nom[m].val<x then begin
            t.nom[m].r:=t.kol;
            t.nom[m].hr:=t.nom[m].hr+1;
            put:=m;
            while put<>0 do begin
            if t.nom[put].hr>t.nom[put].hl then begin
               n:=put;put:=t.nom[put].f;
               if t.nom[put].val<t.nom[n].val then
                   t.nom[put].hr:=t.nom[put].hr+1
                   else t.nom[put].hl:=t.nom[put].hl+1;
                   end else put:=0;
               end;
             end;
         if t.nom[m].val>x then begin
            t.nom[m].l:=t.kol;
            t.nom[m].hl:=t.nom[m].hl+1;
            put:=m;
            while put<>0 do begin
            if t.nom[put].hl>t.nom[put].hr then begin
               n:=put;put:=t.nom[put].f;
               if t.nom[put].val<t.nom[n].val then
                   t.nom[put].hr:=t.nom[put].hr+1
                   else t.nom[put].hl:=t.nom[put].hl+1;
                   end else put:=0;
               end;
            end;
       end;
       end;
    end;

  procedure reverseR(n:integer;var t:tree);
  var m,i,put,h:integer;
  begin
  m:=t.nom[n].l;
  t.nom[m].f:=t.nom[n].f;
  t.nom[n].f:=m;
  t.nom[n].l:=t.nom[m].r;
  t.nom[m].r:=n;
  t.nom[n].hl:=t.nom[m].hr;
  t.nom[m].hr:=t.nom[n].hr+1;
  i:=t.nom[m].f;
  if i<>0 then begin
     if t.nom[i].val<t.nom[m].val then t.nom[i].r:=m
     else t.nom[i].l:=m;
     end;

  put:=m;
  while put<>0 do begin
    if t.nom[put].hr>=t.nom[put].hl then h:=t.nom[put].hr
    else h:=t.nom[put].hl;
    m:=put;
    put:=t.nom[put].f;
    if put<>0 then begin
    if t.nom[put].val<t.nom[m].val then t.nom[put].hr:=h+1
    else t.nom[put].hl:=h+1;
    end;
  end;
  end;

  procedure reverseL(n:integer;var t:tree);
  var m,i,put,h:integer;
  begin
  m:=t.nom[n].r;
  t.nom[m].f:=t.nom[n].f;
  t.nom[n].f:=m;
  t.nom[n].r:=t.nom[m].l;
  t.nom[m].l:=n;
  t.nom[n].hr:=t.nom[m].hl;
  t.nom[m].hl:=t.nom[n].hl+1;
  i:=t.nom[m].f;
  if i<>0 then begin
     if t.nom[i].val<t.nom[m].val then t.nom[i].r:=m
     else t.nom[i].l:=m;
     end;

  put:=m;
  while put<>0 do begin
    if t.nom[put].hr>=t.nom[put].hl then h:=t.nom[put].hr
    else h:=t.nom[put].hl;
    m:=put;
    put:=t.nom[put].f;
    if put<>0 then begin
    if t.nom[put].val<t.nom[m].val then t.nom[put].hr:=h+1
    else t.nom[put].hl:=h+1;
    end;
  end;
  end;

  procedure otlad(var t:tree);
  var i:integer;

    procedure otl1(x:integer;var tr:tree);
    begin
    if (tr.nom[x].hl-tr.nom[x].hr)>1 then reverseR(x,tr)
       else
           if (tr.nom[x].hr-tr.nom[x].hl)>1 then reverseL(x,tr);
    if tr.nom[x].r<>0 then otl1(tr.nom[x].r,tr);
    if tr.nom[x].l<>0 then otl1(tr.nom[x].l,tr);
    end;

  begin
  for i:=1 to t.kol do
  otl1(i,t);
  end;

  procedure delete(x:integer;var t:tree);
  var i,m,k,n,put,h:integer;
      prod:boolean;
  begin
  if t.kol<>0 then begin
  i:=1;
  prod:=true;
  while (t.nom[i].val<>x)and(i<>t.kol) do i:=i+1;
  if (i=t.kol) and (t.nom[i].val<>x) then prod:=false;

  if prod then begin
   n:=i;writeln('n=',n);
   if t.nom[n].hr>=t.nom[n].hl then begin
   writeln('*');
   while t.nom[n].l<>0 do reverseR(n,t);
   m:=t.nom[n].r;
   t.nom[m].f:=t.nom[n].f;
   k:=t.nom[n].f;
   t.nom[k].hr:=t.nom[k].hr-1;
   if t.nom[k].val>t.nom[m].val then t.nom[k].l:=m
      else t.nom[k].r:=m;

  put:=m;
  while put<>0 do begin
    if t.nom[put].hr>=t.nom[put].hl then h:=t.nom[put].hr
    else h:=t.nom[put].hl;
    m:=put;
    put:=t.nom[put].f;
    if put<>0 then begin
    if t.nom[put].val<t.nom[m].val then t.nom[put].hr:=h+1
    else t.nom[put].hl:=h+1;
    end;
    end;

   end else begin
   writeln('**');
   while t.nom[n].r<>0 do reversel(n,t);
   m:=t.nom[n].l;
   t.nom[m].f:=t.nom[n].f;
   k:=t.nom[n].f;
   t.nom[k].hl:=t.nom[k].hl-1;
   if t.nom[k].val>t.nom[m].val then t.nom[k].l:=m
      else t.nom[k].r:=m;

  put:=m;
  while put<>0 do begin
    if t.nom[put].hr>=t.nom[put].hl then h:=t.nom[put].hr
    else h:=t.nom[put].hl;
    m:=put;
    put:=t.nom[put].f;
    if put<>0 then begin
    if t.nom[put].val<t.nom[m].val then t.nom[put].hr:=h+1
    else t.nom[put].hl:=h+1;
    end;
   end;
   end;

  for i:=n to t.kol-1 do begin
   t.nom[i].val:=t.nom[i+1].val;

   if (t.nom[i+1].r>=n)and(t.nom[i+1].r<>0) then
   t.nom[i].r:=t.nom[i+1].r-1
   else   t.nom[i].r:=t.nom[i+1].r;

   if (t.nom[i+1].l>=n)and(t.nom[i+1].l<>0) then
   t.nom[i].l:=t.nom[i+1].l-1
   else t.nom[i].l:=t.nom[i+1].l;

   t.nom[i].hr:=t.nom[i+1].hr;
   t.nom[i].hl:=t.nom[i+1].hl;

   if (t.nom[i+1].f>=n)and(t.nom[i+1].f<>0) then
   t.nom[i].f:=t.nom[i+1].f-1
   else t.nom[i].f:=t.nom[i+1].f;
   end;
  t.kol:=t.kol-1;

   for i:=1 to n-1 do begin
   if (t.nom[i].r>=n)and(t.nom[i].r<>0) then
   t.nom[i].r:=t.nom[i].r-1
   else   t.nom[i].r:=t.nom[i].r;

   if (t.nom[i].l>=n)and(t.nom[i].l<>0) then
   t.nom[i].l:=t.nom[i].l-1
   else t.nom[i].l:=t.nom[i].l;

   if (t.nom[i].f>=n)and(t.nom[i].f<>0) then
   t.nom[i].f:=t.nom[i].f-1
   else t.nom[i].f:=t.nom[i].f;
   end;
   end;
  end;
 end;



end.