program AVLtreework;
uses CRT,Graph;

type PTree = ^TTree;
	 TTree = record
	 	info:byte;
		balance: integer;
		left,right: PTree;
	end;

function max(v1,v2:integer):integer;
begin
     if (v1>v2) then
        max:=v1
     else
         max:=v2;
end;

function getint(ident:string):byte;
var s:byte;
begin
	write('Введите ',ident,' : ');
	readln(s);
	getint:=s;
end;

procedure RotateSingleLL(var root:PTree);
Var LBranch:PTree;
begin
	LBranch:=root^.left;
        if (LBranch^.balance=-1) then
         begin
           LBranch^.balance:=0;
           root^.balance:=0;
         end
        else
          begin
            LBranch^.balance:=1;
            root^.balance:=-1;
          end;

	root^.left:=LBranch^.right;
	Lbranch^.right:=root;
	root:=LBRanch;
end;

procedure RotateSingleRR(var root:PTree);
var RBranch:PTree;
begin
	RBranch:=root^.right;

        if (RBranch^.balance=1) then
          begin
           RBranch^.balance:=0;
           root^.balance:=0;
          end
        else
          begin
            RBranch^.balance:=-1;
            root^.balance:=1;
          end;

	root^.right:=RBranch^.left;
	RBranch^.left:=root;
	root:=RBRanch;
end;

procedure RotateDoubleLR(var root:PTree);
Var LBranch,LRBranch:PTree;
begin
	Lbranch:=root^.left;
	LRbranch:=Lbranch^.right;
        if (LRbranch^.balance = 1) then
           lbranch^.balance:=-1
        else
            lbranch^.balance:=0;

        if (LRBranch^.balance = -1) then
           root^.balance:=1
        else
            root^.balance:=0;

        lrbranch^.balance:=0;

	root^.left:=LRbranch^.right;
	Lbranch^.right:=LRbranch^.left;
	LRbranch^.left:=Lbranch;
	LRBranch^.right:=root;

	root:=LRbranch;
end;

procedure RotateDoubleRL (var root:PTree);
Var Rbranch,RLbranch:PTree;
begin
	Rbranch:=root^.right;
	RLbranch:=RBranch^.left;

        if (RLBranch^.balance = -1) then
           rbranch^.balance:=1
        else
            rbranch^.balance:=0;

        if (RLBranch^.balance=1) then
           root^.balance:=-1
        else
            root^.balance:=0;

        rlbranch^.balance:=0;

	root^.right:=RLbranch^.left;
	Rbranch^.left:=RLbranch^.right;
	RLbranch^.right:=Rbranch;
	RLbranch^.left:=root;

	root:=RLbranch;
end;

procedure RebalanceTree(var root:PTree;var rebalance:boolean);
var branch:PTree;
begin
     if (root^.balance=-1) then
        begin
	     branch:=root^.left;
	     if (branch^.balance=-1) or (branch^.balance=0) then
	        begin
		     RotateSingleLL(root);
		     rebalance:=false;
		end
	     else
	     if (branch^.balance=1) then
	     begin
	          RotateDoubleLR(root);
		  rebalance:=false;
	     end;
	end
     else
         if (root^.balance=1) then
	    begin
	         branch:=root^.right;
		 if (branch^.balance=1) or (branch^.balance=0) then
		    begin
		         RotateSingleRR(root);
			 rebalance:=false;
		    end
		 else
		 if (branch^.balance=-1)  then
		    begin
		         RotateDoubleRL(root);
			 rebalance:=false;
		    end;
	    end;
end;

Procedure HeavyLeft(var root:PTree;var rebalance:boolean);
begin
     case root^.balance of
          -1 : begin
	            RebalanceTree(root,rebalance);
	       end;
	  0 : begin
	           root^.balance:=-1;
		   rebalance:=true;
	      end;
	  1 : begin
	           root^.balance:=0;
		   rebalance:=false;
	      end;
	  end;
end;

Procedure HeavyRight(var root:PTree;var rebalance:boolean);
begin
     case root^.balance of
          -1 : begin
	            root^.balance:=0;
		    rebalance:=false;
               end;
	  0 : begin
	           root^.balance:=1;
		   rebalance:=true;
	      end;
	  1: begin
	          RebalanceTree(root,rebalance);
	     end;
     end;
end;

procedure addelem(var root:PTree;info:byte;var rebalance:boolean);
var elem:PTree;
	rebalancethiselem:boolean;
begin
     if (root=NIL) then
        begin
	     new(elem);
	     elem^.left:=NIL;
	     elem^.right:=NIL;
	     elem^.info:=info;
	     elem^.balance:=0;
	     rebalance:=TRUE;
	     root:=elem;
	end
     else
         begin
	      if (info<root^.info) then
	         begin
		      addelem(root^.left,info,RebalanceThisElem);
		      if (RebalanceThisElem) then
                         HeavyLeft(root,rebalance)
		      else
		          rebalance:=false;
		 end
	      else
		  begin
		       addelem(root^.right,info,rebalancethiselem);
		       if (rebalancethiselem) then
		          begin
                               HeavyRight(root,rebalance)
			  end
		       else
		           rebalance:=false;
		  end;
	 end;
end;

procedure addelem_wrapper(var root:PTree;info:byte);
var rebalance:boolean;
begin
	rebalance:=false;
	addelem(root,info,rebalance);
end;

procedure printLKP(root:PTree);
begin
	if (root<>NIL) then
		begin
			printLKP(root^.left);
			write(root^.info,' ');
			printLKP(root^.right);
		end;
end;

procedure printLKP_wrapper(root:PTree);
begin
	clrscr;
	if (root=NIL) then
		writeln('Дерево пусто!')
	else
		PrintLKP(root);
	writeln;
	writeln('Нажмите любую клавишу для выхода в главное меню');
	readkey;
end;

procedure printKLP(root:PTree);
begin
	if (root<>NIL) then
		begin
			write(root^.info,' ');
			printKLP(root^.left);
			printKLP(root^.right);
		end;
end;

procedure printKLP_wrapper(root:PTree);
begin
	clrscr;
	if (root=NIL) then
		writeln('Дерево пусто!')
	else
		PrintKLP(root);
	writeln;
	writeln('Нажмите любую клавишу для выхода в главное меню');
	readkey;
end;

procedure printLPK(root:PTree);
begin
	if (root<>NIL) then
		begin
			printLPK(root^.left);
			printLPK(root^.right);
			write(root^.info,' ');
		end;
end;

procedure printLPK_wrapper(root:PTree);
begin
	clrscr;
	if (root=NIL) then
		writeln('Дерево пусто!')
	else
		PrintLPK(root);
	writeln;
	writeln('Нажмите любую клавишу для выхода в главное меню');
	readkey;
end;

function countels(root:PTree):integer;
begin
	if (root<>NIL) then
		countels:=1+countels(root^.left)+countels(root^.right)
	else
		countels:=0;
end;

procedure countels_wrapper(root:PTree);
begin
	writeln('Число вершин дерева : ',countels(root));
	writeln('Нажмите любую клавишу');
	writeln;
	readkey;
end;

function countleafs(root:PTree):integer;
begin
	if (root<>NIL) then
		if (root^.left=NIL) and (root^.right=NIL) then
			countleafs:=1
		else
			countleafs:=countleafs(root^.left)+countleafs(root^.right)
	else
		countleafs:=0;
end;

procedure countleafs_wrapper(root:PTree);
begin
	writeln('Число листов дерева : ',countleafs(root));
	writeln;
	writeln('Нажмите любую клавишу');
	readkey;
end;

function countdepth(root:PTree;level:integer):integer;
var dr,dl:integer;
begin
	if (root=NIL) then
		countdepth:=level-1
	else
            countdepth:=max(countdepth(root^.left,level+1),countdepth(root^.right,level+1));

end;

procedure countdepth_wrapper(root:PTree);
begin
     if (root<>NIL) then
      begin
	writeln('Глубина дерева : ',countdepth(root,0));
	writeln;
	writeln('Нажмите любую клавишу');
      end
     else
         writeln('Дерево пусто!');
	readln;
end;

function getmostright(root:PTree):byte;
begin
	if (root^.right=NIL) then
		getmostright:=root^.info
	else
		getmostright:=getmostright(root^.right);

end;
procedure DelRebalanceTree(var root:PTree;var rebalance:boolean);
var branch:PTree;
begin
     if (root^.balance=-1) then
        begin
	     branch:=root^.left;
	     if (branch^.balance=-1) or (branch^.balance=0) then
	        begin
		     RotateSingleLL(root);
		     rebalance:=false;
		end
	     else
	     if (branch^.balance=1) then
	     begin
	          RotateDoubleLR(root);
		  rebalance:=false;
	     end;
	end
     else
         if (root^.balance=1) then
	    begin
	         branch:=root^.right;
		 if (branch^.balance=1) or (branch^.balance=0) then
		    begin
		         RotateSingleRR(root);
			 rebalance:=false;
		    end
		 else
		 if (branch^.balance=-1) then
		    begin
		         RotateDoubleRL(root);
			 rebalance:=false;
		    end;
	    end;
end;

Procedure LightLeft(var root:PTree;var rebalance:boolean);
begin
     case root^.balance of
          1 : begin
	            DelRebalanceTree(root,rebalance);
	       end;
	  0 : begin
	           root^.balance:=1;
		   rebalance:=false;
	      end;
	  -1 : begin
	           root^.balance:=0;
		   rebalance:=true;
	      end;
	  end;
end;

Procedure LightRight(var root:PTree;var rebalance:boolean);
begin
     case root^.balance of
          1 : begin
	            root^.balance:=0;
		    rebalance:=true;
               end;
	  0 : begin
	           root^.balance:=-1;
		   rebalance:=false;
	      end;
	  -1: begin
	          DelRebalanceTree(root,rebalance);
	     end;
     end;
end;

procedure delelem(var root:PTree;info:byte;var rebalance:boolean);
var temp:PTree;
    RebalanceThisElem:boolean;
    OldRebalance:boolean;
    OldDepthL,OldDepthR:integer;
    DepthL,DepthR:integer;
begin
     if (root<>NIL) then
     begin
          if (info<root^.info) then
             begin
	          delelem(root^.left,info,RebalanceThisElem);
                  if (RebalanceThisElem) then
                     LightLeft(root,rebalance)
                  else
                      rebalance:=false;
             end
	  else
	      if (info>root^.info) then
                 begin
	              delelem(root^.right,info,RebalanceThisElem);
                      if (RebalanceThisElem) then
                         LightRight(root,rebalance)
                      else
                          rebalance:=false;
                 end
	      else
	          begin
		       if (root^.left=NIL) and (root^.right=NIL) then
		          begin
			       dispose(root);
			       root:=NIL;
                               rebalance:=TRUE;
			  end
		       else
		       if (root^.left=NIL) and (root^.right<>NIL) then
		       begin
		            temp:=root;
			    root:=root^.right;
			    dispose(temp);
                            rebalance:=TRUE;
		       end
		       else
		       if (root^.left<>NIL) and (root^.right=NIL) then
		       begin
		            temp:=root;
			    root:=root^.left;
			    dispose(temp);
                            rebalance:=TRUE;
		       end
		       else
		       begin
		            root^.info:=getmostright(root^.left);
                            olddepthl:=countdepth(root^.left,1);
                            olddepthr:=countdepth(root^.right,1);
			    delelem(root^.left,root^.info,RebalanceThisElem);
                            depthl:=countdepth(root^.left,1);
                            depthr:=countdepth(root^.right,1);
                            if (max(olddepthl,olddepthr)<>max(depthl,depthr)) or (abs(depthr-depthl)>1) then
                               LightLeft(root,rebalance)
                            else
                                begin
                                     rebalance:=false;
                                     root^.balance:=depthr-depthl;
                                end;
		       end;
	      end;
	  end
     else
         begin
              rebalance:=false;
         end;
end;

procedure delelem_wrapper(var root:PTree;info:byte);
var rb:boolean;
begin
     rb:=false;
     delelem(root,info,rb);
end;

procedure printlevel(root:Ptree;level,curlevel:integer);
begin
	if (root<>NIL) then
		begin
			if (curlevel=level) then
				write(root^.info,' ')
			else
				begin
					printlevel(root^.left,level,curlevel+1);
					printlevel(root^.right,level,curlevel+1);
				end;
		end;
end;

procedure printlevel_wrapper(root:PTree;level:integer);
begin
	clrscr;
	writeln('Все вершины на уровне ',level,' : ');
	printlevel(root,level,0);
	writeln;
	writeln('Нажмите любую клавишу для выхода в главное меню');
	readkey;
end;

procedure drawtree(root:PTree);
var Width,Height:integer;
    CurVPort:ViewPortType;
    s,sbal:string;
begin
     if (root<>NIL) then
        begin
             GetViewSettings(CurVPort);
             width:=CurVPort.x2-CurVPort.x1;
             height:=CurVPort.y2-CurVPort.y1;
             str(root^.info,s);
             str(root^.balance,sbal);
             sbal:='('+sbal+')';
             SetColor(15);
             Ellipse(width div 2,11,0,360,20,11);
             SetFillStyle(SolidFill,7);
             FloodFill(width div 2,11,15);
             SetColor(8);
             OutTextXY(width div 2,4,s);
             OutTextXY(width div 2,12,sbal);
             SetColor(15);
             if (root^.left<>NIL) then
                line(width div 2,22,width div 4,height);
             if (root^.right<>NIL) then
                line(width div 2,22,3*width div 4,height);
             with CurVPort do
                  setviewport(x1,y2,x1+(width div 2),y2+height,ClipOff);
             drawtree(root^.left);
             with CurVPort do
                  setviewport(x1+(width div 2),y2,x2,y2+height,ClipOff);
             drawtree(root^.right);
        end;
end;

procedure drawtree_wrapper(root:PTree);
Var GraphDevice,GraphMode:integer;
    PathToDriver:string;
begin
     if (root<>NIL) then
        begin
             GraphDevice:=Detect;
             PathToDriver:='';
             InitGraph(GraphDevice,GraphMode,PathToDriver);
             if (GraphResult<>grOK) then
               begin
                  Writeln('Error initializing graphics!');
                  readkey;
               end
             else
               begin
                  SetColor(White);
		  SetViewPort(15,0,GetMaxX-15,(GetMaxY div (countdepth(root,0)+1)),ClipOff);
                  SetTextJustify(CenterText,TopText);
                  drawtree(root);
                  readkey;
                  closegraph;
               end
        end
     else
       begin
         writeln('Дерево пусто!');
         readkey;
       end;
end;

procedure showmenu;
begin
	clrscr;
	writeln(' AVL-дерево');
	writeln;
	writeln('  1) Добавить элемент в дерево');
	writeln('  2) Распечатать дерево в виде левая ветвь - корень - правая ветвь (ЛКП)');
	writeln('  3) Распечатать дерево в виде корень - левая ветвь - правая ветвь (КЛП)');
	writeln('  4) Распечатать дерево в виде левая ветвь - правая ветвь - корень (ЛПК)');
	writeln('  5) Вывести число вершин дерева');
	writeln('  6) Вывести число листов дерева');
	writeln('  7) Удалить элемент из дерева');
	writeln('  8) Распечатать все вершины на заданном уровне');
	writeln('  9) Вывести глубину дерева');
	writeln(' 10) Нарисовать дерево');
       	writeln(' 11) Выход');
	writeln;
	write('Ваш выбор : ');

end;

Var Tree:PTree;
	selection:integer;

begin
	Tree:=NIL;

	repeat
		showmenu;
		readln(selection);
		writeln;
		case selection of
			1: addelem_wrapper(Tree,getint('элемент для добавления'));
			2: printLKP_wrapper(Tree);
			3: printKLP_wrapper(Tree);
			4: printLPK_wrapper(Tree);
			5: countels_wrapper(Tree);
			6: countleafs_wrapper(Tree);
			7: delelem_wrapper(Tree,getint('элемент для удаления'));
			8: printlevel_wrapper(Tree,getint('уровень, который нужно распечатать'));
			9: countdepth_wrapper(Tree);
                        10: drawtree_wrapper(Tree);
			11:clrscr;
		end;
	until selection=11;
end.