unit Drzewa;

interface
type AVL=^wezel; //typ wskaznikowy drzewa wyważonego
       wezel=record
        el:Integer;
        h:Integer;
        lewy:AVL;
        prawy:AVL;
        licznik:Integer;
        wywazenie:-1..+1; //z dodatkowa informacja o wspólczynniku wywazenia wezla
        end;           {czyli róznicy wys. prawego i lewego podrzewa, jeli
                        hl<hp wywaz=1: przeważone w jakąs strone
                        hl=hp wywaz=0: równowaga
                        hl>hp wywaz=-1: konieczne jest ponowne wywazenie}
type tablica = array of integer;



procedure utworz_d_wywaz(tab:tablica;left:Integer;right:Integer);

//procedure wstaw_d(key:Integer);
procedure wyswietl_inord(tmp:AVL);
function wys_d(tmp:AVL):Integer;
procedure wstaw_d_wywaz(key:Integer;var current:AVL;var wys_poddrz:Boolean);
procedure usun_d_wywaz(key:Integer;var current:AVL; var wys_poddrz_u:boolean);
procedure wywazanie_P(var current:AVL; var wys_poddrz_u:boolean);
procedure wywazanie_L(var current:AVL; var wys_poddrz_u:boolean);
procedure wyszukaj_d(key:Integer;tmp:AVL);
procedure usun_caled(var tmp:AVL);
procedure przegladaj_d(tmp:AVL);

var
root,parent_wywaz:AVL; //korzen drzewa AVL
wys_calk:Integer;   //calkowita wys drzewa
wys_poddrz:Boolean; //przechowuje info czy wys. poddrzewa zwiekszyla sie przy wstawianiu
wys_poddrz_u:Boolean; //przechowuje info czy wys. poddrzewa zwiekszyla sie przy usuwaniu
wysokosc:Integer; //zlicza rekurencje dzieki czemu daje wys wezla przy jego wstawianiu
ilosc_wywazen:Integer; //przechowuje info o ilosci wywazen podczas wstawiania n elementow
ilosc_wywazen_u:Integer; //przechowuje info o ilosci wywaze podczas usuwania n elementow
wst_polowkowe,tworzenie_polowkowe:Boolean;


implementation

//=====================Tworzenie drzewa=======================================//



procedure utworz_d_wywaz(tab:tablica;left:Integer;right:Integer);

var
  indeks:Integer;
begin
  if (left<=right) then
  begin
    indeks:=(left+right) div 2;
    if (tworzenie_polowkowe=True) then
      wst_polowkowe:=True;
    wstaw_d_wywaz(tab[indeks],root,wys_poddrz);
    utworz_d_wywaz(tab,left,indeks-1);
    utworz_d_wywaz(tab,indeks+1,right);
  end;
end;

//=====================Wstawianie nowego węzla================================//

procedure wstaw_d_wywaz(key:Integer; var current:AVL;var wys_poddrz:Boolean);
var
  tmp1,tmp2:AVL;
begin

  if (current=nil) then //warunek stopu dla rekurencji, brak klucz wiec trzeba
    begin               // go wstawic
      New(current);
      with current^ do                // i dlatego sie ono nie wykonuje
      begin
        el:=key;
        lewy:=nil;
        prawy:=nil;
        h:=wysokosc;
        licznik:=1;
        wywazenie:=0;
      end;
      wysokosc:=0;   //zerowanie wysokosci aby dla nstapnej zmiennej znowu byla ona liczona

      if (wst_polowkowe=False) then   //jezeli odbywa sie wstawianie polowkowe
        wys_poddrz:=True             //to flaga od wywazania caly czas jest false
      else wys_poddrz:=False;

    end


  else if (key < current^.el) then
  begin
    Inc(wysokosc);
    wstaw_d_wywaz(key,current^.lewy,wys_poddrz);   //wywolanie rekurencyjne
    if wys_poddrz then  //jezeli urosla lewa galaz
    case current^.wywazenie of
      1: begin
          current^.wywazenie:=0;
          wys_poddrz:=false;
         end;
      0: current^.wywazenie:=-1;
     -1: begin //wywaz drzewo
          Inc(ilosc_wywazen);
          tmp1:=current^.lewy; //wskaznik tmp1 wskazuje na lewe podrz biezacego
                               //czyli na A w obu przyp.
                               //w LL current= B, w LP current= C
            if (tmp1^.wywazenie=-1) then
            begin                     //pojedyńcze wywazanie LewoLewo
              current^.lewy:=tmp1^.prawy;   //jako lewe poddrz B wstaw prawe A
              tmp1^.prawy:=current;  //podnies A, ustaw B jako jego prawe poddrz
              current^.wywazenie:=0;
              //if (current^.right<>nil) then Inc(current^.right^.wys);
              //if (tmp1^.left<>nil) then Dec(tmp1^.left^.wys);
              //Inc(current^.wys);  //zwiekszenie wysokosci bo B opadlo na dól
              //Dec(tmp1^.wys); //zmniejszenie wys bo A poszlo do gory
              current:=tmp1;
            end
            else
            begin  //podwójna zamiana LP
              tmp2:=tmp1^.prawy; //wskaznk tmp2 wskazuje na prawo poddrz tmp1 (na B)
              tmp1^.prawy:=tmp2^.lewy;//jako prawe poddrz A wstaw lewe poddrz B
              tmp2^.lewy:=tmp1;   //wstaw A jako prawe poddrz B
              current^.lewy:=tmp2^.prawy; //wstaw prawe poddrz B jako lewe poddrz C
              tmp2^.prawy:=current;    //wstaw poddrz C jako prawe poddrz B
              //if (tmp1^.right<>nil) then Dec(tmp1^.right^.wys);
              //if (current^.left<>nil) then Dec(current^.left^.wys);
              //Inc(current^.wys);
              //tmp2^.wys:=tmp2^.wys-2;
              if (tmp2^.wywazenie=-1) then
                current^.wywazenie:=1
              else
                current^.wywazenie:=0;
              if (tmp2^.wywazenie=1) then
                tmp1^.wywazenie:=-1
              else
                tmp1^.wywazenie:=0;;

              current:=tmp2;
            end;
            current^.wywazenie:=0;  // tutaj zerujemy tmp2 bo wczesniej bylo podstawienie current:=tmp2;
            wys_poddrz:=false;
         end;
    end;
  end
  else
  if ( key > current^.el) then
  begin
    Inc(wysokosc);
    wstaw_d_wywaz(key,current^.prawy,wys_poddrz); //rekurencyjne wywolanie dla prawego poddrzewa
    if wys_poddrz then //urosla prawa galaz
    case current^.wywazenie of
      -1: begin                  //jak wstawiam lewego syna to wspolczynnik wywazenia ojca zmienia sie na -1
            current^.wywazenie:=0;   //tutaj gdy dostawie do niego prawego podsyna to jego wspolczynnim znowu wraca do 0
            wys_poddrz:=false;   // czyli do stanu równowagi
          end;
       0: current^.wywazenie:=1;
       1: begin //wywaz drzewo
            Inc(ilosc_wywazen);
            tmp1:=current^.prawy;     //pod tmp1 wstawiam prawy w zwiazku z lusstrzanym odbiciem
            if (tmp1^.wywazenie=1) then
            begin //pojedyncza zamiana PP
              current^.prawy:=tmp1^.lewy;
              tmp1^.lewy:=current;
              current^.wywazenie:=0;
              //if (current^.left<>nil) then Inc(current^.left^.wys);
              //if (tmp1^.right<>nil) then Dec(tmp1^.right^.wys);
              //Inc(current^.wys);
              //Dec(tmp1^.wys);
              current:=tmp1;    // current zostaje na tym samym poziomie, podstawinie wykonuje sie ze wzgkedu na podniesienie A
            end                 //a obnizenie B, na które wczesniej wskazywal current
            else
            begin //podwójna zamiana PL
              tmp2:=tmp1^.lewy;
              tmp1^.lewy:=tmp2.prawy;
              tmp2^.prawy:=tmp1;
              current^.prawy:=tmp2^.lewy;
              tmp2^.lewy:= current;
              //if (tmp1^.left<>nil) then Dec(tmp1^.left^.wys);
              //if (current^.right<>nil) then Dec(current^.right^.wys);
              //Inc(current^.wys);
             // tmp2^.wys:=tmp2^.wys-2;
              if (tmp2^.wywazenie=1) then
                current^.wywazenie:=-1
              else
                current^.wywazenie:=0;
              if (tmp2^.wywazenie=-1) then
                tmp1^.wywazenie:=1
              else
                tmp1^.wywazenie:=0;

              current:=tmp2;
            end;
            current^.wywazenie:=0;
            wys_poddrz:=false;
         end;
    end;
  end
  else
    wys_poddrz:=False;
end;


//==============Usuwanie elementu z drzewa====================================//


procedure wywazanie_L(var current:AVL; var wys_poddrz_u:Boolean);
var
  tmp1,tmp2:AVL;
  w1,w2:-1..+1;
begin  // wys_poddrz_u=true, prawa galaz sie zmniejszyla
  case current^.wywazenie of
    1: current^.wywazenie:=0; //jezeli bylo przechylone to teraz jest zrownowazone
    0: begin
        current^.wywazenie:= -1;
        wys_poddrz_u:=False;
       end;
   -1: begin //wywazanie
        Inc(ilosc_wywazen_u);
        tmp1:=current^.lewy;
        w1:=tmp1^.wywazenie;
        if (w1<=0) then //pojedyncza zamiana LL
          begin
            current^.lewy:=tmp1^.prawy; //rotacja LL
            tmp1^.prawy:=current;
            if (w1=0) then
            begin
              current^.wywazenie:=-1;
              tmp1^.wywazenie:=1;
              wys_poddrz_u:=false;
            end
            else
            begin
              current^.wywazenie:=0;
              tmp1^.wywazenie:=0;
            end;
            current:=tmp1;
          end
        else
        begin //podwójna zamiana LP
          tmp2:=tmp1^.prawy;
          w2:=tmp2^.wywazenie;
          tmp1^.prawy:=tmp2^.lewy;
          tmp2^.lewy:=tmp1;
          current^.lewy:=tmp2^.prawy;
          tmp2^.prawy:=current;
          if (w2=-1) then
            current^.wywazenie:=1
          else
            current^.wywazenie:=0;
          if (w2=1) then
            tmp1^.wywazenie:=-1
          else
            tmp1^.wywazenie:=0;

          current:=tmp2;
          tmp2^.wywazenie:=0;
        end;
       end;
   end;
end;




procedure wywazanie_P(var current:AVL; var wys_poddrz_u:Boolean);
var
  tmp1,tmp2:AVL;
  w1,w2:-1..+1;
begin  // wys_poddrz_u=true, lewa galaz sie zmniejszyla
  case current^.wywazenie of
   -1: current^.wywazenie:=0; //jezeli bylo przechylone to teraz jest zrownowazone
    0: begin
        current^.wywazenie:= 1;
        wys_poddrz_u:=False;
       end;
    1: begin //wywazanie
        Inc(ilosc_wywazen_u);
        tmp1:=current^.prawy;
        w1:=tmp1^.wywazenie;
        if (w1>=0) then //pojedyncza zamiana PP
          begin
            current^.prawy:=tmp1^.lewy; //rotacja PP
            tmp1^.lewy:=current;
            if (w1=0) then
            begin
              current^.wywazenie:=1;
              tmp1^.wywazenie:=-1;
              wys_poddrz_u:=false;
            end
            else
            begin
              current^.wywazenie:=0;
              tmp1^.wywazenie:=0;
            end;
            current:=tmp1;
          end
        else
        begin //podwójna zamiana PL
          tmp2:=tmp1^.lewy;
          w2:=tmp2^.wywazenie;
          tmp1^.lewy:=tmp2^.prawy;
          tmp2^.prawy:=tmp1;
          current^.prawy:=tmp2^.lewy;
          tmp2^.lewy:=current;
          if (w2=1) then
            current^.wywazenie:=-1
          else
            current^.wywazenie:=0;

          if (w2=-1) then
            tmp1^.wywazenie:=1
          else
            tmp1^.wywazenie:=0;

          current:=tmp2;
          tmp2^.wywazenie:=0;
        end;
       end;
   end;
end;


procedure usun_d_wywaz(key:Integer;var current:AVL; var wys_poddrz_u:boolean);
var
  q:AVL;

  procedure usun_w2sons(var p:AVL; var wys_poddrz_u:Boolean);
  var pomocn:AVL;
  begin  //wys_poddrz_u=False           //usuwanie dla przypadku gdy wezel
    if (p^.prawy<>nil) then             //ma dwóch synów
    begin
      usun_w2sons(p^.prawy,wys_poddrz_u);
      if wys_poddrz_u then
        wywazanie_L(p,wys_poddrz_u);
    end
    else
    begin
      q^.el:=p^.el;
      q:=p;
      p:=p^.lewy;
      wys_poddrz_u:=True;
    end;
  end;

begin  //usun
 if(current=nil) then
  begin
    //Writeln('Brak klucza w drzewie!!!');
    wys_poddrz_u:=False;
  end
 else if (key<current^.el) then
    begin
      usun_d_wywaz(key,current^.lewy,wys_poddrz_u);
      if wys_poddrz_u then
        wywazanie_P(current,wys_poddrz_u);
    end
  else if (key>current^.el) then
    begin
      usun_d_wywaz(key,current^.prawy,wys_poddrz_u);
      if wys_poddrz_u then
        wywazanie_L(current,wys_poddrz_u);
    end
  else
  begin //usuwanie current^
    q:=current;
    if (q^.prawy=nil) then
    begin
      current:=q^.lewy;
      wys_poddrz_u:=true;
    end
    else
    if (q^.lewy=nil) then
    begin
      current:=q^.prawy;
      wys_poddrz_u:=true;
    end
    else
    begin
      usun_w2sons(q^.lewy,wys_poddrz_u);   //usuwanie dwóch synów metoda raz w lewo i
      if wys_poddrz_u then                 // do konca w prawo
        wywazanie_P(current,wys_poddrz_u);
    end;
    Dispose(q);
  end;
end;

//========================Wyszukiwanie wezla w drzewie========================//
procedure wyszukaj_d(key:Integer;tmp:AVL);

begin
  if (tmp<>nil) and (key<>tmp^.el) then
    if (key < tmp^.el) then
      wyszukaj_d(key,tmp^.lewy)
    else
      wyszukaj_d(key,tmp^.prawy)
  {else if (tmp<>nil) then
    Writeln(tmp^.klucz); }
end;

//=====================Usuwanie calego drzewa================================//

procedure usun_caled(var tmp:AVL);

begin
  if (tmp<>nil) then
  begin
      usun_caled(tmp^.lewy);
      usun_caled(tmp^.prawy);
      Dispose(tmp);
      tmp:=nil;
  end;
end;


//====================Przegladanie drzewa======================================//
procedure przegladaj_d(tmp:AVL);
begin
  if (tmp<>nil) then
  begin
    przegladaj_d(tmp^.lewy);
    Inc(tmp^.el);
    przegladaj_d(tmp^.prawy);
  end;
end;

//========================Wysokosc drzewa=====================================//

function wys_d(tmp:AVL):Integer;
begin
  if (tmp<>nil) then
  begin
    wys_d(tmp^.lewy); //rekurencyjne wywolanie lewego poddrzewa
    if (tmp^.h > wys_calk) then
      wys_calk:=tmp^.h;
    wys_d(tmp^.prawy);  //rekurencyjne wywoalnie prawego poddrzewa
  end;
  Result:=wys_calk;
end;

//========================Wywswietlanie  w porządku inorder===================//

procedure wyswietl_inord(tmp:AVL);
begin
  if (tmp<>nil) then
  begin
    wyswietl_inord(tmp^.lewy);
    Write(tmp^.el);
    Writeln('   ',tmp^.wywazenie);
    wyswietl_inord(tmp^.prawy);
  end;
end;
























end.