; Демонстрация функций, моделирующих выполнение в бинарном
   ; дереве поиска операций:
   ;   (1) "ротация";
   ;   (2) "спаренный поворот (двусторонний и односторонний)".
   ;
   ;  Запуск функции на выполнение:
   ;
   ;  >muLISP85 SplTree.sys 201-01.LSP
   ;
   ; Автор: И.А.Кудрявцева (18.01.2007)
   ; **********************************
   (DEFUN TEST (LAMBDA NIL
      (PRINT "Построение числового бинарного дерева поиска:")
      (SETQ Tree NIL)
      (LOOP
         (PRIN1 "Введите очередной элемент дерева (окончание !): ")
         (SETQ X (READ)) ( (EQ X '!) )
         (PRINT (SETQ Tree (AddTree X Tree)))
      )  
      (WRS Pvrt.txt)
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0))
      (PRINT "Ротация вправо:") 
      (PRINT (OutTree (SETQ Tree (Rot_Right Tree)) 0)) 
      (PRINT "______________")
      (PRINT "Ротация влево:")
      (PRINT (OutTree (SETQ Tree (Rot_Left Tree)) 0))
      (PRINT "Получено исходное бинарное дерево.") 
      (PRINT "Спаренный двусторонний поворот вправо:") 
      (PRINT (OutTree (ZigZag_R Tree) 0))
      (PRINT "________________________________")
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0))
      (PRINT "Спаренный двусторонний поворот влево:")
      (PRINT (OutTree (ZigZag_L Tree) 0))
      (PRINT "________________________________")
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0))
      (PRINT "Спаренный односторонний поворот вправо:") 
      (PRINT (OutTree (ZigZig_R Tree) 0))
      (PRINT "________________________________")
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0))
      (PRINT "Спаренный односторонний поворот влево:")
      (PRINT (OutTree (ZigZig_L Tree) 0))
      (WRS)
   ))
   (RDS)

   ; Демонстрация функции, которая по заданному  бинарному
   ; дереву поиска Tree возвращает преобразованное дерево,
   ; корнем которого стала заданная вершина A, в результа-
   ; те многократного выполнения операции "ротация".
   ;  Запуск функции на выполнение:
   ;
   ;  >muLISP85 SplTree.sys 201-02.LSP
   ;
   ; Автор: И.А.Кудрявцева (03.07.2006)
   ; **********************************
   (DEFUN TEST (LAMBDA NIL
      (PRINT "Построение числового бинарного дерева поиска:")
      (SETQ Tree NIL)
      (LOOP
         (PRIN1 "Введите очередной элемент дерева (окончание !): ")
         (SETQ X (READ)) 
         ( (EQ X '!) )
         (PRINT (SETQ Tree (AddTree X Tree)))
      )  
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0)) 
      (LOOP
         (PRIN1 "Введите элемент дерева (окончание !): ")
         (SETQ A (READ)) ( (EQ A '!) )
         (PRINT "Результат ротации (изменение корня дерева):")
         (PRINT (OutTree (SETQ Tree (Root_A A Tree)) 0))
      )
   ))
   ; ----------------------------
   (DEFUN Root_A (LAMBDA (A Tree)
   ; Функция, которая по числовому бинарному дереву Tree
   ; возвращает преобразованное дерево, корнем  которого
   ; стала заданная вершина A в результате многократного
   ; выполнения операции "ротация"
   ; -----------------------------
      (COND ( (NULL Tree) Tree )
            ( (OR (AND (NOT (Search A (Left Tree))) 
                       (NOT (Search A (Right Tree))))
                  (EQUAL (Root Tree) A)) Tree )
            (  T  (Root_A A (RotInTree A Tree)) ))
   ))
   ; ***************************
   ; Неудачные тестовые примеры:
   ; ---------------------------
   (WRS TstRot.txt)
   ; ---------------------------------------------------
   "Root_A - ротация дерева, в результате которой корнем
         дерева становится заданная вершина A"
   ; -----------------------------------------
   (EQUAL (Root_A 3 '()) '())
   (EQUAL (Root_A 83 '(65 NIL (83 NIL NIL))) '(83 (65 NIL NIL) NIL))
   (EQUAL (Root_A 55 '(65 NIL (83 NIL NIL))) '(65 NIL (83 NIL NIL)))
   (EQUAL (Root_A 14 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                              (13 (12 NIL NIL) (14 NIL NIL)))
                          (20 (16 NIL NIL) (22 NIL NIL))))
          '(14 (11 (8 (7 NIL NIL) (10 NIL NIL)) 
                   (13 (12 NIL NIL) NIL))
               (15 NIL (20 (16 NIL NIL) (22 NIL NIL)))))
   (EQUAL (Root_A 7 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                             (13 (12 NIL NIL) (14 NIL NIL)))
                         (20 (16 NIL NIL) (22 NIL NIL))))
          '(7 NIL (15 (11 (8 NIL (10 NIL NIL)) 
                          (13 (12 NIL NIL) (14 NIL NIL)))
                      (20 (16 NIL NIL) (22 NIL NIL)))))
   (EQUAL (Root_A 16 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                              (13 (12 NIL NIL) (14 NIL NIL)))
                          (20 (16 NIL NIL) (22 NIL NIL))))
          '(16 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL))) NIL)
               (20 NIL (22 NIL NIL))))
   (EQUAL (Root_A 22 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                              (13 (12 NIL NIL) (14 NIL NIL)))
                          (20 (16 NIL NIL) (22 NIL NIL))))
          '(22 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL)))
                   (20 (16 NIL NIL) NIL)) NIL))
   ; ------------------------------------------
   (WRS)
   (RDS)

   ; Демонстрация функции, которая по бинарному дереву  поиска
   ; Tree возвращает преобразованное дерево Tree, корнем кото-
   ; рого становится одна из его вершин A в результате  много-
   ; кратного выполнения операции "спаренный поворот" и  (воз-
   ; можно) однократного выполнения операции "ротация".
   ;  Запуск функции на выполнение:
   ;
   ;  >muLISP85 SplTree.sys 201-03.LSP
   ;
   ; Автор: И.А.Кудрявцева (04.07.2006)
   ; **********************************
   (DEFUN TEST (LAMBDA NIL
      (PRINT "Построение числового бинарного дерева поиска:")
      (SETQ Tree NIL)
      (LOOP
         (PRIN1 "Введите очередной элемент дерева (окончание !): ")
         (SETQ X (READ))
         ( (EQ X '!) )
         (PRINT (SETQ Tree (AddTree X Tree)))
      )  
      (PRINT "Числовое бинарное дерево поиска:") 
      (PRINT (OutTree Tree 0)) 
      (LOOP
         (PRIN1 "Введите элемент дерева (окончание !): ")
         (SETQ A (READ))
         ( (EQ A '!) )
         (PRINT "Результат поворотов (изменение корня дерева):")
         (PRINT (OutTree (SETQ Tree (SpRoot_A A Tree)) 0))
      )
   ))
   ; ------------------------------
   (DEFUN SpRoot_A (LAMBDA (A Tree)
   ; Функция, которая по заданному числовому  бинарному дереву
   ; поиска Tree возвращает преобразованное дерево, корнем ко-
   ; торого стала одна из его вершин A в результате многократ-
   ; ного выполнения операции "спаренный поворот"  (и, возмож-
   ; но, однократного выполнения операции "ротация")
   ; -----------------------------------------------
      (COND ( (NULL Tree) Tree )
            ( (OR (AND (NOT (Search A (Left Tree))) 
                       (NOT (Search A (Right Tree))))
                  (EQUAL (Root Tree) A)) Tree )
            ( (EQUAL (Root (Left Tree)) A) (Rot_Right Tree) )
            ( (EQUAL (Root (Right Tree)) A) (Rot_Left Tree) )
            (  T  (SpRoot_A A (SparPov A Tree)) ))
   ))
   ; ***************************
   ; Неудачные тестовые примеры:
   ; ---------------------------
   (WRS TstSpRt.txt)
   ; ---------------
   "SpRoot_A"
   ; --------------------------
   (EQUAL (SpRoot_A 3 '()) '())
   (EQUAL (SpRoot_A 83 '(65 NIL (83 NIL NIL))) '(83 (65 NIL NIL) NIL))
   (EQUAL (SpRoot_A 63 '(65 (63 NIL NIL) NIL)) '(63 NIL (65 NIL NIL)))
   (EQUAL (SpRoot_A 55 '(65 NIL (83 NIL NIL))) '(65 NIL (83 NIL NIL)))
   (EQUAL (SpRoot_A 7 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                               (13 (12 NIL NIL) (14 NIL NIL)))
                           (21 (17 (16 NIL NIL) (18 NIL NIL))
                               (23 (22 NIL NIL) (24 NIL NIL)))))
          '(7 NIL (15 (8 NIL (11 (10 NIL NIL)  
                                 (13 (12 NIL NIL) (14 NIL NIL))))
                      (21 (17 (16 NIL NIL) (18 NIL NIL)) 
                          (23 (22 NIL NIL) (24 NIL NIL))))))
   (EQUAL (SpRoot_A 10 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(10 (8 (7 NIL NIL) NIL) 
               (15 (11 NIL (13 (12 NIL NIL) (14 NIL NIL)))
                   (21 (17 (16 NIL NIL) (18 NIL NIL)) 
                       (23 (22 NIL NIL) (24 NIL NIL))))))
   (EQUAL (SpRoot_A 12 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(12 (11 (8 (7 NIL NIL) (10 NIL NIL)) NIL)
               (15 (13 NIL (14 NIL NIL)) 
                   (21 (17 (16 NIL NIL) (18 NIL NIL))
                       (23 (22 NIL NIL) (24 NIL NIL))))))
   (EQUAL (SpRoot_A 14 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(14 (13 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (12 NIL NIL)) NIL)
               (15 NIL (21 (17 (16 NIL NIL) (18 NIL NIL)) 
                           (23 (22 NIL NIL) (24 NIL NIL))))))
   (EQUAL (SpRoot_A 16 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(16 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL))) NIL)
               (17 NIL (21 (18 NIL NIL)
                           (23 (22 NIL NIL) (24 NIL NIL))))))
   (EQUAL (SpRoot_A 18 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(18 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL)))
                   (17 (16 NIL NIL) NIL))
               (21 NIL (23 (22 NIL NIL) (24 NIL NIL)))))
   (EQUAL (SpRoot_A 22 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(22 (15 (11 (8 (7 NIL NIL) (10 NIL NIL)) 
                       (13 (12 NIL NIL) (14 NIL NIL)))
                   (21 (17 (16 NIL NIL) (18 NIL NIL)) NIL))
               (23 NIL (24 NIL NIL))))
   (EQUAL (SpRoot_A 24 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(24 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL)))
                   (23 (21 (17 (16 NIL NIL) (18 NIL NIL))
                           (22 NIL NIL)) NIL)) NIL))
   (EQUAL (SpRoot_A 15 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                   (13 (12 NIL NIL) (14 NIL NIL)))
               (21 (17 (16 NIL NIL) (18 NIL NIL))
                   (23 (22 NIL NIL) (24 NIL NIL)))))
   (EQUAL (SpRoot_A 21 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                            (21 (17 (16 NIL NIL) (18 NIL NIL))
                                (23 (22 NIL NIL) (24 NIL NIL)))))
          '(21 (15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                       (13 (12 NIL NIL) (14 NIL NIL)))
                   (17 (16 NIL NIL) (18 NIL NIL)))
               (23 (22 NIL NIL) (24 NIL NIL))))
   (EQUAL (SpRoot_A 11 '(15 (11 (8 (7 NIL NIL) (10 NIL NIL))
                                (13 (12 NIL NIL) (14 NIL NIL)))
                             (21 (17 (16 NIL NIL) (18 NIL NIL))
                                 (23 (22 NIL NIL) (24 NIL NIL)))))
          '(11 (8 (7 NIL NIL) (10 NIL NIL))
               (15 (13 (12 NIL NIL) (14 NIL NIL))
                   (21 (17 (16 NIL NIL) (18 NIL NIL))
                       (23 (22 NIL NIL) (24 NIL NIL))))))
   ; ----------------------------------------------------
   (WRS)
   (RDS)

   /* Демонстрации реализации операций "левая ротация" */
   /* и "правая ротация" с помощью изменения исходного */
   /* бинарного дерева поиска.                         */
   /*                                                  */
   /* Автор: Швецкий М.В. (26.01.2013)                 */
   /* ------------------------------------------------ */
   #include "tree-1.h"
   #include "tree-1.c"
      struct node *RotR(struct node *);
      struct node *RotL(struct node *);
  /* -------------------------------- */
   int main()
   {
      struct node *Tree; /* Указатель на корень дерева     */
      struct node *Res;  /* Указатель на найденную вершину */
      struct node *q;
      int el;
      /* ---------------------------------------------- */
      printf("Свободное место в 'куче': %u\n",coreleft());
      srand(time(NULL));
      Tree=BuildTreeRand(Tree); Vyvod(Tree,0); printf("\n");
      /* ---------------------------------------------------- */
      printf("Введите ключ искомой вершины: "); scanf("%d",&el);
      Res=Poisk(el,Tree);
      /* ------------------------------ */
      /*    Найдём указатель на отца    */
      /* ------------------------------ */
      q=Poisk(Father(Res->Key,Tree),Tree);
      printf("\nКлюч отца: %d\n",q->Key);
      /* ----------------------------- */
      if (!(q->Key))
	Tree=RotL(Res);
      else {
	     if (q->Left)
	       if (q->Left->Key==el)
		 q->Left=RotL(Res);
	       else;
	     else;
	     if (q->Right)
	       if (q->Right->Key==el)
		 q->Right=RotL(Res);
	       else;
	     else;
	   }
      printf("\n"); Vyvod(Tree,0); printf("\n");
      /* ------------------------------------ */
      CleanTree(&Tree);
      printf("Свободное место в 'куче': %u\n",coreleft());
      getch();
      return 0;
   }
   /* ------------------------------ */
   struct node *RotR(struct node *Tree)
   {
      struct node *q=Tree, *q1;
       // ----------------------
      if (!Tree)
         ;
      else if (Tree->Left)
           {
             q1=Tree->Left->Right;
	     Tree=q->Left; Tree->Right=q; q->Left=q1;
           }
           else;
      return Tree;
   }
   /* ------------------------------ */
   struct node *RotL(struct node *Tree)
   {
      struct node *q=Tree,*q1;
       // ---------------------
      if (!Tree)
         ;
      else if (Tree->Right)
           {
             q1=Tree->Right->Left;
	     Tree=q->Right; Tree->Left=q; q->Right=q1;
           }
           else;
      return Tree;
   }