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

unit AVLtree1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N3: TMenuItem;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Insert1(Sender: TObject);
    procedure Delete1(Sender: TObject);
    procedure Exit1(Sender: TObject);
    procedure Print(Sender: TObject);
    procedure Paint(Sender: TObject);
    procedure Intf(Sender: TObject);
    procedure Ins1(Sender: TObject);
    procedure Del1(Sender: TObject);
    procedure Insn(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

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

   var b:tree;

implementation

{$R *.dfm}

  procedure line(x1,y1,x2,y2:integer);
  begin
  form1.Canvas.MoveTo(x1,y1);
  form1.Canvas.LineTo(x2,y2);
  end;


  function check(s:string):boolean;
  var c,n:integer;
  begin
  val(s,n,c);
  if c<>0 then check:=false else check:=true

  end;

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

   procedure print(x,y,n,sm:integer;var tr:tree);
   begin
   form1.Canvas.Pen.Color:=clred;
   form1.Canvas.Brush.Color:=clgreen;
   form1.Canvas.Ellipse(x-10,y-10,x+20,y+20);
   form1.Canvas.TextOut(x,y,inttostr(tr.nom[n].val));
   sm:=sm div 2;

   if tr.nom[n].r<>0 then begin
      line(x+15,y+15,x+sm,y+70);
      print(x+sm,y+70,tr.nom[n].r,sm,tr);
      end;

   if tr.nom[n].l<>0 then begin
      line(x-10,y+10,x-sm,y+70);
      print(x-sm,y+70,tr.nom[n].l,sm,tr);
      end;
   end;

   begin
   form1.Canvas.Brush.Color:=clwhite;
   form1.Canvas.Rectangle(20,30,400,430);
   i:=1;
   while t.nom[i].f<>0 do i:=i+1;
   put:=i;
   x1:=200;
   y1:=50;
   sm:=200;
   print(x1,y1,put,sm,t);
   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 TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
b.kol:=0;
for i:=1 to 100 do begin
b.nom[i].val:=0;
b.nom[i].r:=0;
b.nom[i].l:=0;
b.nom[i].hr:=0;
b.nom[i].hl:=0;
b.nom[i].f:=0;
end;
end;





procedure TForm1.Insert1(Sender: TObject);
var x,i,put,m,n:integer;
    prod:boolean;
begin
if check(edit1.Text) then begin

x:=strtoint(edit1.Text);

prod:=true;
for i:=1 to b.kol do
        if b.nom[i].val=x then prod:=false;
if prod then begin


if b.kol=0 then begin
        b.nom[1].val:=x;
        b.kol:=1
        end else begin
 {Дерево не пусто}
  i:=1;
  while b.nom[i].f<>0 do i:=i+1;
  put:=i;
   m:=0;
  while put<>0 do begin
  m:=put;
  if b.nom[put].val<x then put:=b.nom[put].r;
  if b.nom[put].val>x then put:=b.nom[put].l;
  end;

  b.kol:=b.kol+1;
  n:=b.kol;
  b.nom[n].val:=x;
  b.nom[n].f:=m;
        {Если в правое поддерево}
        if b.nom[m].val<x then begin
            b.nom[m].r:=b.kol;
            b.nom[m].hr:=b.nom[m].hr+1;
            put:=m;
            while put<>0 do begin
            if b.nom[put].hr>b.nom[put].hl then begin
               n:=put;put:=b.nom[put].f;
               if b.nom[put].val<b.nom[n].val then
                   b.nom[put].hr:=b.nom[put].hr+1
                   else b.nom[put].hl:=b.nom[put].hl+1;
                   end else put:=0;
               end;
             end;
          {Если в левое поддерево}
         if b.nom[m].val>x then begin
            b.nom[m].l:=b.kol;
            b.nom[m].hl:=b.nom[m].hl+1;
            put:=m;
            while put<>0 do begin
            if b.nom[put].hl>b.nom[put].hr then begin
               n:=put;put:=b.nom[put].f;
               if b.nom[put].val<b.nom[n].val then
                   b.nom[put].hr:=b.nom[put].hr+1
                   else b.nom[put].hl:=b.nom[put].hl+1;
                   end else put:=0;
               end;
            end;
end;
 otlad(b);
 if b.kol<>0 then printtree(b);
 end;
end;
end;

procedure TForm1.Delete1(Sender: TObject);
var x,k,i,n,put,m,h:integer;
    prod:boolean;
begin
if check(edit1.Text) then begin
x:=strtoint(edit1.Text);

if b.kol<>0 then begin
   i:=1;
  prod:=true;
  while (b.nom[i].val<>x)and(i<>b.kol) do i:=i+1;
  if (i=b.kol) and (b.nom[i].val<>x) then prod:=false;

  if prod then begin
    n:=i;
      {Вращение правого, чтобы добраться до элемента}
       if b.nom[n].hr>=b.nom[n].hl then begin
   while b.nom[n].l<>0 do reverseR(n,b);
   m:=b.nom[n].r;
   b.nom[m].f:=b.nom[n].f;
   k:=b.nom[n].f;
   b.nom[k].hr:=b.nom[k].hr-1;
   if b.nom[k].val>b.nom[m].val then b.nom[k].l:=m
      else b.nom[k].r:=m;

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

   end else begin {Вращение левого }
   while b.nom[n].r<>0 do reversel(n,b);
   m:=b.nom[n].l;
   b.nom[m].f:=b.nom[n].f;
   k:=b.nom[n].f;
   b.nom[k].hl:=b.nom[k].hl-1;
   if b.nom[k].val>b.nom[m].val then b.nom[k].l:=m
      else b.nom[k].r:=m;

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

  {Смещение записей в карте}
  for i:=n to b.kol-1 do begin
   b.nom[i].val:=b.nom[i+1].val;

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

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

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

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

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

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

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

  end;

 end;
end;


procedure TForm1.Exit1(Sender: TObject);
begin
form1.Close
end;

procedure TForm1.Print(Sender: TObject);
begin
if b.kol<>0 then begin
printtree(b);
end;
end;




procedure TForm1.Paint(Sender: TObject);
begin
form1.Canvas.Brush.Color:=clwhite;
form1.Canvas.Rectangle(20,30,400,430);
end;



procedure TForm1.Intf(Sender: TObject);
var f:textfile;
    x:integer;
begin
    if form1.OpenDialog1.Execute then begin
     assignfile(f,opendialog1.FileName);
     reset(f);
     while not eof(f) do begin
     read(f,x);
     edit1.Text:=inttostr(x);
     button1.Click
     end;
     end;
 end;




procedure TForm1.Ins1(Sender: TObject);
begin
form1.Button1.Click;
end;

procedure TForm1.Del1(Sender: TObject);
begin
form1.Button3.Click;
end;

procedure TForm1.Insn(Sender: TObject);
var fs:textfile;
    s:string;
    x:integer;
begin
s:=edit1.Text;
assignfile(fs,'avltree.txt');
rewrite(fs);
write(fs,s);
closefile(fs);
reset(fs);
     while not eof(fs) do begin
     read(fs,x);
     edit1.Text:=inttostr(x);
     button1.Click
     end;
end;

end.