www.gcmsite.ru

Новости Программы PHP-скрипты Статьи Числа
Услуги Резюме Игры Автомобили Поиск

СИСТЕМНОЕ И ВЕБ-ПРОГРАММИРОВАНИЕ
компьютерная техника, игры

Нужна программа, скрипт или сайт? Анализ сайта или оптимизация? Копирайт или рерайт текстов? Заявка на выполнение работ.

Операции над бинарным деревом AVL

Язык: Borland Pascal 7.0

Курс: Алгоритмы и структуры данных

В данной статье рассматривается:

  • Поиск в дереве заданного узла без вставки
  • Поиск в дереве заданного узла со вставкой
  • Подсчёт количества узлов в дереве
  • Подсчёт количества концевых узлов в дереве
  • Удаление узла из дерева
  • Повороты LR LL
  • Вывод верева на экран
  • Включение нового узла
  • Удаление всего дерева
  • Поиск узла по ключу
Program Derevo_AVL;                   {    Make 11.01.1999    }
  Uses                                {  All rights reserved  }
    Crt;
  Type
    Typel = integer;
    Ref = ^z;
    z = record
          inf         : Typel;
          bal         : -2..2;
          left, right : Ref
        end;
  Var
    key              : Char;
    stop             : Boolean;
    h                : Integer;
    root,p           : Ref;
    s                : Typel;
    ok               : Boolean;
 
{--------------------------------------------------------------------------}
  Procedure Ramka;
    var
      i    : integer;
    begin
      TextColor(13);
      For i:=1 to 47 do
        begin
          Gotoxy(15+i,9);
          Write('Н');
          Gotoxy(15+i,18);
          Write('Н')
        end;
      For i:=1 to 8 do
        begin
          Gotoxy(16,9+i);
          Write('є');
          Gotoxy(62,9+i);
          Write('є')
        end;
      Gotoxy(62,9);
      Write('>');
      Gotoxy(16,9);
      Write('Й');
      Gotoxy(62,18);
      Write('_');
      Gotoxy(16,18);
      Write('И')
    end;
{--------------------------------------------------------------------------}
{  Поиск в дереве заданного узла без вставки }
  Procedure Poisk(root:ref);
    begin
      if root <> nil
        then
          begin
            if root^.inf = s
              then
                ok:=true;
            poisk(root^.right);
            poisk(root^.left)
          end
    end;
{--------------------------------------------------------------------------}
 
  Procedure Print2 (root:ref; h:integer; s: typel);
    var
      i: integer;
    begin
      if root<>nil
        then
          begin
            print2(root^.right,h+2,s);
            for i:=1 to h do
              write(' ');
            if root^.inf = s
              then
                textcolor(14)
              else
                textcolor(15);
            writeln(root^.inf);
            print2(root^.left,h+2,s);
          end
    end;
 
  Procedure Printing;
    begin
      TextColor(1);
      ClrScr;
      TextColor(15);
      if root = nil
        then
          begin
            Writeln('Дерево не задано...');
            ReadKey;
            TextColor(1);
            ClrScr;
            Exit
          end;
      Write('Что ищем (?) : ');
      Readln(s);
      Ok:=false;
      poisk(root);
      Print2(root,0,s);
      TextColor(15);
      if not ok
        then
          writeln('Узел ''',s,''' не найден...')
        else
          writeln('Узел ''',s,''' найден...');
      ReadKey;
      TextColor(1);
      ClrScr
    end;
{--------------------------------------------------------------------------}
{  Поиск в дереве заданного узла со вставкой }
  Procedure Poisk2(x:typel;var p: ref; var h : boolean);
    var
      p1,p2 : ref;
    begin
      if p = nil
        then
          begin
            new (p);
            h := true;
            p^.inf := x;
            p^.left := nil;
            p^.right := nil;
            p^.bal := 0
          end
        else
          if x < p^.inf then
            begin
              Poisk2(x, p^.left, h);
              if h
                then
                  if p^.bal = 0
                    then
                      p^.bal:=-1
                    else
                      if p^.bal = 1
                        then
                          begin
                            p^.bal:=0;
                            h:=false
                          end
                        else
                          if p^.bal = -1
                            then
                              begin
                                p1 := p^.left;
                                if p1^.bal = -1
                                 then
                                   begin    { LL ПОВОРОТ }
                                     p^.left := p1^.right;
                                     p1^.right := p;
                                     p^.bal := 0;
                                     p1^.bal := 0;
                                     h:=false;
                                     p := p1
                                   end
                                 else
                                   begin     { LR ПОВОРОТ }
                                     p2 := p1^.right;
                                     h:=false;
                                     p^.left := p2^.right;
                                     p2^.right := p;
                                     p1^.right:=p2^.left;
                                     p2^.left:=p1;
                                     Case p2^.bal of
                                       1:begin
                                           p1^.bal := -1;
                                           p^.bal:=0
                                         end;
                                      -1:begin
                                           p1^.bal := 0;
                                           p^.bal:=1
                                         end;
                                       0:begin
                                           dec(p1^.bal,1);
                                           inc(p^.bal,1)
                                         end;
                                     end;
                                     p := p2;
                                     p^.bal:=0
                                   end
                         end;
                  end
          else
            if x > p^.inf
              then
                begin
                  Poisk2(x, p^.right, h);
                  if h
                    then
                      if p^.bal = 0
                        then
                          p^.bal:=1
                        else
                          if p^.bal = -1
                            then
                              begin
                                p^.bal:=0;
                                h:=false
                              end
                            else
                              if p^.bal = 1
                                then
                                  begin
                                    p1 := p^.right;
                                    if p1^.bal = 1
                                     then
                                       begin    { RR ПОВОРОТ }
                                         p^.right := p1^.left;
                                         p1^.left := p;
                                         p^.bal := 0;
                                         p1^.bal := 0;
                                         h:=false;
                                         p := p1
                                       end
                                     else
                                       begin     { RL ПОВОРОТ }
                                         p2 := p1^.left;
                                         h:=false;
                                         p^.right := p2^.left;
                                         p2^.left := p;
                                         p1^.left:=p2^.right;
                                         p2^.right:=p1;
                                         Case p2^.bal of
                                           1:begin
                                               p1^.bal := 0;
                                               p^.bal:=-1
                                             end;
                                          -1:begin
                                               p1^.bal := 1;
                                               p^.bal:=0
                                             end;
                                           0:begin
                                               inc(p1^.bal,1);
                                               dec(p^.bal,1)
                                             end;
                                         end;
                                         p := p2;
                                         p^.bal:=0
                                       end
                             end;
                      end
              else
                begin
                  h := False;
                  ok:=true
                  { Найден узел с заданными значениями ключа }
                end
    end;
{--------------------------------------------------------------------------}
{ Подсчёт количества узлов в дереве }
  Function Count(p:ref):integer;
    begin
      if p = nil
        then
          count:=0
        else
          count:=1+count(p^.left)+count(p^.right)
    end;
{--------------------------------------------------------------------------}
{ Подсчёт количества концевых узлов в дереве }
  Function Count2(p:ref):integer;
    begin
      if p <> nil
        then
          begin
            if p^.left = p^.right
              then
                count2:=1
              else
                count2:=count2(p^.left)+count2(p^.right)
          end
        else
          count2:=0
    end;
{--------------------------------------------------------------------------}
{ Удаление узла из дерева }
  Procedure RebuildL(var root : ref; var h : Boolean);
    Procedure LR (var root:ref; var h:boolean);
      var
        p, q, r : ref;
      begin
        h := False;
        p := root;
        q := root^.left;
        r := q^.right;
        root := r;
        q^.right := r^.left;
        p^.left := r^.right;
        r^.left := q;
        r^.right := p;
        Case r^.bal of
        1 : begin
              p^.bal := 0;
              q^.bal := -1
            end;
        -1: begin
              p^.bal := 1;
              q^.bal := 0
            end;
        end;
        r^.bal := 0
      end;
 
    Procedure LL (var root : ref; var h : Boolean);
      var
        p, q : ref;
      begin
        h := False;
        p := root;
        q := root^.left;
        p^.left := q^.right;
        q^.right := p;
        root := q;
        q^.bal := 0;
        p^.bal := 0
      end;
  begin
    If root^.left^.bal = -1
      then
        LL (root, h);
    If root^.left^.bal = 1
      then
        LR (root, h)
  end;
 
  Procedure RebuildR (var root : ref; var h : Boolean);
    Procedure RR (var root : ref; var h : Boolean);
      var
        p, q : ref;
      begin
        h := False;
        p := root;
        q := root^.right;
        p^.right := q^.left;
        q^.left := p;
        root := q;
        q^.bal := 0;
        p^.bal := 0
      end;
    Procedure RL (var root : ref; var h : Boolean);
      var
        p, q, r : ref;
      begin
        h := False;
        p := root;
        q := root^.right;
        r := q^.left;
        root := r;
        q^.left := r^.right;
        p^.right := r^.left;
        r^.right := q;
        r^.left := p;
        Case r^.bal of
        1 : begin
              p^.bal := -1;
              q^.bal := 0
            end;
        -1: begin
              q^.bal := 1;
              p^.bal := 0
            end
        end
      end;
  begin
    If root^.right^.bal = -1
      then
        RL (root, h);
    If root^.right^.bal = 1
      then
        RR (root, h);
  end;
  Procedure Delete (var root : ref; x : integer);
    var
      q : ref;
      h : Boolean;
    Procedure Del2 (var r : ref);
      begin
        If r^.right <> nil
          then
            begin
              Del2 (r^.right);
              r^.bal := r^.bal - 1;
              h := True;
              If r^.bal = -2
                then
                  begin
                    r^.bal:=-1;
                    RebuildL (r, h)
                  end
            end
          else
            begin
              q^.inf := r^.inf;
              q := r;
              r := r^.left
            end
      end;
  begin
    If root <> nil then
      If x < root^.inf then
      begin
        Delete (root^.left, x);
        Case root^.bal of
          1: RebuildR (root, h);
         -1: begin
               root^.bal := 0;
               h := True
             end;
          0: begin
               root^.bal := 1;
               h := False
             end
        end
      end
    else
    If x > root^.inf
      then
        begin
          Delete (root^.right, x);
          Case root^.bal of
            1: begin
                 root^.bal := 0;
                 h := False
               end;
            0: begin
                 root^.bal := -1;
                 h := True
               end;
           -1: RebuildL (root, h)
          end
        end
      else
        begin
          q := root;
          If root^.left = nil
            then
              root := root^.right
            else
              If root^.right = nil
                then
                  root := root^.left
                else
                  Del2 (root^.left);
          Dispose (q)
        end
  end;
  Procedure DelPunkt;
    begin
      TextColor(1);
      ClrScr;
      TextColor(15);
      Write('Введите ключ : ');
      Readln(s);
      ok:=false;
      Poisk(root);
      If ok
        then
          begin
            ok:=false;
            Delete(root,s);
            Writeln('Узел удалён...');
            if Count(root) = 0
              then
                Writeln('Дерево уничтожено.')
          end
        else
          begin
            Writeln('Узел не удалён, т.к. его в дереве нет !!!');
            if Count(root) = 0
              then
                Writeln('Да и самого дерева тоже нет.')
          end;
      ReadKey;
      TextColor(1);
      ClrScr
    end;
{--------------------------------------------------------------------------}
  Procedure PrintTree_txt( root : ref; h: integer);
    var
      i: integer;
    begin
      if root<>nil
        then
          begin
            printtree_txt(root^.right,h+2);
            for i:=1 to h do
              write(' ');
            writeln(root^.inf);
            printtree_txt(root^.left,h+2);
          end
    end;
{--------------------------------------------------------------------------}
  Procedure PrintPunkt;
    begin
      textcolor(1);
      clrscr;
      textcolor(11);
      if root = nil
        then
          writeln('Дерево не задано...')
        else
          begin
            printtree_txt(root,0);
            writeln('Количество узлов в дереве : ',Count(root));
            writeln('Количество концевых узлов в дереве (Function of '+
            '10.01.1999) : ',Count2(root))
          end;
      readkey;
      textcolor(1);
      textbackground(1);
      clrscr
    end;
{--------------------------------------------------------------------------}
  Procedure DelPunkt2;
    var
      i : integer;
    begin
      i:=count(root);
      while root <> nil do
        delete(root,root^.inf);
      root:=nil;
      if not stop
        then
          begin
            textcolor(1);
            clrscr;
            textcolor(10);
            if i = 0
              then
                writeln('Дерево не задано...')
              else
                writeln('Дерево уничтожено...');
            readkey;
            textcolor(1);
            textbackground(1);
            clrscr
        end
    end;
{--------------------------------------------------------------------------}
  Procedure Insert_Punkt;
    var
      i,x     : integer;
      s,s1    : integer;
      h       : boolean;
    begin
      TextColor(1);
      ClrScr;
      TextColor(15);
      Gotoxy(28,10);
      Write('1-Вставка по ключу.');
      Gotoxy(28,11);
      Write('2-Вставка по RANDOM.');
      key:=ReadKey;
      TextColor(1);
      ClrScr;
      TextColor(15);
      If key = '1'
        then
          begin
            Write('Введите ключ : ');
            Readln(s);
            ok:=false;
            h:=false;
            Poisk2(s,root,h);
            If ok
              then
                Writeln('Узел с данным ключём уже существует...')
              else
                Writeln('Ok...');
            ReadKey;
            TextColor(1);
            ClrScr;
            Exit
          end;
      If key = '2'
        then
          begin
            Write('Сколько вставляем узлов: ');
            Readln(x);
            s1:=Count(root);
            i:=0;
            While i < x do
              begin
                ok:=true;
                while ok do
                  begin
                    s:=Random(x+s1+10);
                    ok:=false;
                    Poisk2(s,root,h);
                    if not ok
                      then
                        inc(i)
                  end;
              end;
            Writeln('Ok...');
            ReadKey
          end;
      TextColor(1);
      ClrScr
    end;
{--------------------------------------------------------------------------}
Begin
 { new(root);}
  root:=nil;
  TextColor(1);
  TextBackground(1);
  ClrScr;
  stop:=false;
  While not stop do
    begin
      Ramka;
      TextColor(11);
      Gotoxy(17,2);
      Writeln('Программа студента гр. ПА-97  Шарова Евгения');
      Gotoxy(30,23);
      Writeln('All rights reserved.');
      TextColor(10);
      Gotoxy(24,7);
      Writeln('Операции над бинарным деревом.');
      TextColor(15);
      Gotoxy(20,11);
      Write('Вывод верева на экран.................1');
      Gotoxy(20,12);
      Write('Включение нового узла.................2');
      Gotoxy(20,13);
      Write('Удаление узла.........................3');
      Gotoxy(20,14);
      Write('Удаление всего дерева.................4');
      Gotoxy(20,15);
      Write('Поиск узла по ключу...................5');
      Gotoxy(20,16);
      Write('Выход в ДОС...........................6');
      key:=ReadKey;
      Case key of
        '1' : PrintPunkt;
        '2' : Insert_Punkt;
        '3' : DelPunkt;
        '4' : DelPunkt2;
        '5' : Printing;
        '6' : stop:= not stop
        else
          begin
            Sound(160);
            Delay(17);
            NoSound
          end
      end
    end;
  DelPunkt2;
  TextMode(3)
End.




JavaScript — это язык веб-программирования, работающий на стороне клиента, позволяющий автоматизировать какую-либо деятельность на странице сайта, не нагружая сервер. Вся нагрузка лежит на компьютере пользователя. В нем можно создавать функции, а также использовать базовые алгоритмы, состоящие из следования-ветвления-цикла. Чаще всего программный код на языке JavaScript обрабатывается обычными веб-браузерами.

Интересные материалы на сайте:

Рейтинг@Mail.ru     Автор, разработчик: Шаров Евгений   (gcmsite@yandex.ru)
(c) 2000-2017 GCM-Site - системное и веб-программирование
Цитирование материалов сайта возможно только при наличии гиперссылки