Шаг 140.
Основы языка Haskell. Рекурсивные типы данных. Бинарные деревья поиска. Демонстрационные примеры

    На этом шаге мы приведем несколько примеров использования бинарных деревьев.

    Приведем несколько демонстрационных примеров.

   -- Демонстрация работы с "отцами" и "сыновьями"
   -- в бинарных деревьях поиска
   -- **************************
   import Tree
   -----------------------------------------------------------
   -- Функция возвращает "отца" для заданной  вершины a число-
   -- вого бинарного дерева поиска tree;
   -- fathers - накапливающий параметр
   --           (при вызове fathers=[]),
   -- который содержит список "отцов", построенный  в процессе
   -- поиска вершины a в бинарном дереве поиска tree
   -------------------------------------------------
   srchFath:: Int -> BTree -> [Int] -> Int
   srchFath a tree fathers 
              | isEmpty tree = error "Дерево пусто"
              | a==root tree && null fathers
                             = error "Отца у вершины нет"
              | a==root tree = head fathers
              | a<root tree  = srchFath a 
                                        (left tree) 
                                        (root tree : fathers)
              | True         = srchFath a
                                        (right tree) 
                                        (root tree : fathers)
   ----------------------------------------------------------
   -- Функция, возвращающая по заданной вершине x список, со-
   -- держащий  её  "сыновей", в  бинарном дереве поиска tree
   -- (0 обозначает корень пустого дерева)
   ---------------------------------------
   srchSon:: Int -> BTree -> [Int]
   srchSon x tree = sons (search x tree)
     where sons tree | isEmpty tree = []
                     | isEmpty (left tree) && isEmpty (right tree)
                                    = [0,0]
                     | isNode (left tree) && isEmpty (right tree)
                                    = [root (left tree),0]
                     | isEmpty (left tree) && isNode (right tree)
                                    = [0,root (right tree)]
                     | True         = [root (left tree),
                                       root (right tree)]
   ------------------------------------------------------
   -- Функция, возвращающая по заданному бинарному дереву
   -- поиска список всех его рёбер
   -------------------------------
   edgeTree:: BTree -> [[Int]]
   edgeTree tree = filter (not . elem 0) (edgeTree' tree)
     where edgeTree' tree 
             | isEmpty tree = []
             | True         = [[root tree,
                                  head (srchSon (root tree) tree)]]
                             ++ [[root tree,
                                 last (srchSon (root tree) tree)]]
                             ++ edgeTree' (left tree)
                             ++ edgeTree' (right tree)
   --------------------------------------------------------------
   -- Предикат, устанавливающий, что бинарное дерево поиска tree1
   -- является поддеревом бинарного дерева поиска tree2
   ----------------------------------------------------
   intT1T2:: BTree -> BTree -> Bool
   intT1T2 tree1 tree2 = intT1T2' (edgeTree tree1) (edgeTree tree2)
     where intT1T2' lst1 lst2
              | null lst1             = True
              | elem (head lst1) lst2 = intT1T2' (tail lst1) lst2
              | True                  = False
   ------------------------------------------------------
   -- Функция, возвращающая по заданному бинарному дереву
   -- поиска tree список троек вида:
   --
   --  [
   --   [Ключ_1, Ключ_корня_левого_поддерева_1, 
   --            Ключ_корня_правого_поддерева_1]
   --   [Ключ_2, Ключ_корня_левого_поддерева_2, 
   --            Ключ_корня_правого_поддерева_2]
   --                        ...
   --   [Ключ_N, Ключ_корня_левого_поддерева_N, 
   --            Ключ_корня_правого_поддерева_N]
   --  ],
   --
   -- где ключи узлов перечисляются в порядке обхода дерева по
   -- уровням и содержатся в списке lst
   ------------------------------------
   trojki:: BTree -> [Int] -> [[Int]]
   trojki tree lst 
         | lst==[] = []
         | True    = ([head lst] ++ srchSon (head lst) tree)
                     : trojki tree (tail lst)
   -- ***************************************
   -- Неудачные тестовые примеры:
   -------------------------------------
   test1 =   srchFath 3 (node 4 (list 3) 
                                (list 5)) []                  == 4
          && srchFath 5 (Node 4 (Node 3 Nil Nil)
                                (Node 5 Nil Nil)) []          == 4
          && srchFath 5 (Node 4 (Node 2 Nil (Node 3 Nil Nil))
                                (Node 6 (Node 5 Nil Nil)
                                        (Node 7 Nil Nil))) [] == 6
          && srchFath 6 (Node 4 (Node 2 Nil (Node 3 Nil Nil))
                                (Node 6 (Node 5 Nil Nil)
                                        (Node 7 Nil Nil))) [] == 4
          && srchFath 17 (Node 10 (Node 6 (Node 3 Nil Nil)
                                          (Node 7 Nil
                                                  (Node 8 Nil Nil)))
                                  (Node 15 (Node 12 Nil Nil)
                                           (Node 18 (Node 17 Nil Nil)
                                                    Nil))) [] == 18
          && srchFath 7 (Node 10 (Node 6 (Node 3 Nil Nil)
                                         (Node 7 Nil
                                                 (Node 8 Nil Nil)))
                                 (Node 15 (Node 12 Nil Nil)
                                          (Node 18 (Node 17 Nil Nil)
                                                   Nil))) []  == 6
   ---------------------------------------------------------------
   -- Вариант оформления тестов:
   -----------------------------
   test2 = srchFath v1 tree1 []
      where v1    = 8
            tree1 = node 4 (list 3) (list 5)
   -----------------------------------------
   test3 = srchFath v2 tree2 []
      where v2 = 10
            tree2 = node 10 (node 6 (list 3)           
                                    (node 7 nil (list 8))) 
                            (node 15 (list 12)         
                                     (node 18 (list 17) nil)) 
   ----------------------------------------------------------
   tree = node 10 (node 6 (list 3)
                          (node 7 nil (list 8)))
                  (node 15 (list 12) 
                           (node 18 (list 17) nil))
   tree1 = newRndTree 60 80 80
   tree2 = node 10 (list 6)
                   (node 15 (list 12) 
                            (node 18 (list 17) nil))
   -------------------------------------------------
   test4 =(   show (srchSon 10 tree) ++ " "
           ++ show (srchSon  8 tree) ++ " "
           ++ show (srchSon 18 tree) ++ " "
           ++ show (srchSon  7 tree),
           tree
          )
   --------------------------------------------------------
   test5 = putStr(   show (trojki tree [10])        ++ "\n"
                  ++ show (trojki tree [6,15])      ++ "\n"
                  ++ show (trojki tree [3,7,12,18]) ++ "\n"
                  ++ show (trojki tree [8,17]))
   --------------------------------------------
   test6 = edgeTree tree
   test7 = do
             outTree tree1
             putStr ("\n"++show (edgeTree tree1))
   test8 = do
             outTree tree; putStr("\n\n") 
             outTree tree2
             putStr ("\n" ++ show (intT1T2 tree2 tree))
Файл с примерами можно взять здесь.
   -- Библиотека для простейшей работы с произвольными
   -- бинарными деревьями
   -- *******************
   import Tree
   --------------------------------------------------------
   -- Функция для построения произвольного бинарного дерева
   -- tree с помощью списка списков вида:
   --
   --  [[a ,b ,0],[a ,b ,1],[a ,b ,1],[a ,b ,0],...,[a ,b ,1]],
   --     1  1      2  2      3  3      4  4          n  n
   --    ¦  ¦  ¦
   --    ¦  ¦  L Направление прикрепления (0 - левое поддерево,
   --    ¦  ¦                             (1 - правое поддерево)
   --    ¦  L--- Отец добавляемого элемента
   --    L------ Добавляемый элемент
   --
   -- Список [a ,a ,...,a ] строится с помощью обхода  бинарного
   --          1  2      n
   -- дерева в ширину
   ------------------------------------
   construct lst tree | null lst = tree
                      | True     = construct (tail lst)
                                             (addTree'' (head lst)
                                                        tree)
   ---------------------------------------------------------------
   -- Функция, добавляющая вершину в произвольное бинарное дерево;
   -- lst - список, содержащий три элемента:
   --   (1) добавляемая вершина;
   --   (2) отец добавляемой вершины;
   --   (3) направление прикрепления (0 - левое поддерево,
   --                                (1 - правое поддерево)
   --------------------------------------------------------
   addTree'' lst tree 
                  | isEmpty tree = node (head lst) nil nil
                  | head (tail lst)==root tree && last lst==0
                                 = node (root tree)
                                        (node (head lst) nil nil)
                                        (right tree)
                  | head (tail lst)==root tree && last lst==1
                                 = node (root tree)
                                        (left tree)
                                        (node (head lst) nil nil)
                  | isNode (search' (left tree) (head (tail lst)))
                                 = node (root tree)
                                        (addTree'' lst (left tree))
                                        (right tree)
                  | isNode (search' (right tree) (head (tail lst)))
                                 = node (root tree)
                                        (left tree)
                                        (addTree'' lst (right tree))
                  | True         = error "Неверные исходные данные"
   ----------------------------------------------------------------
   -- Функция для поиска элемента x в произвольном бинарном
   -- дереве tree (неэффективная функция!)
   ---------------------------------------
   search':: BTree -> Int -> BTree 
   search' tree x | null $ abc tree x= nil
                  | True             = head $ abc tree x
      where abc tree x | isEmpty tree = []
                       | root tree==x = [tree]
                       | True         = abc (left tree) x ++
                                        abc (right tree) x
   -- ****************************************************
   -- Неудачные тестовые примеры:
   ------------------------------
   tree1 = node 10 (node 4 nil
                         (node 6 (list 5)
                                 (node 8 (list 7) (list 9))))
                   (list 12)
   -------------------------
   test1  = search' tree1 10  
   test2  = search' tree1  4  
   test3  = search' tree1 12  
   test4  = search' tree1  6
   test5  = search' tree1  5
   test6  = search' tree1  8
   test7  = search' tree1  7
   test8  = search' tree1  9
   test81 = search' tree1 14
   -------------------------
   test9 = do
             outTree tree1; putStr "\n"
             outTree (addTree'' [100,12,0] tree1)
   ---------------------------------------------------------
   tree2 = construct [[1,0,0],        -- Представление корня
                      [2,1,0],[3,1,1],                
                      [4,2,0],[5,2,1],[6,3,0],[7,3,1],
                      [8,4,0],[9,4,1]]                
                     nil
   ---------------------------------------------------------                          
   tree3 = construct [[13,0,0],       -- Представление корня
                      [10,13,0],[9,13,1],                
                      [4,10,0],[3,10,1],[7,9,0],[8,9,1],
                      [2,4,0],[1,4,1],[2,3,0]]                
                     nil
   test9' = outTree tree3                         
   ----------------------
   test10 = do
              outTree tree2; putStr "\n"
              outTree (construct [[11,8,1],[12,9,0],[13,9,1]]
                                 tree2)
Файл с примерами можно взять здесь.
   -- Демонстрация преобразования бинарного дерева спе-
   -- циальной формы в список и обратно.
   -- 
   -- Авторы: Кудрявцева И.А., Швецкий М.В.
   --                 (01.03.2013,05.03.2013,09.03.2013)
   -----------------------------------------------------
   import Tree
   -------------------------------------------------------
   -- Функция построения бинарного дерева по списку вершин
   -- полученных в результате обхода другого бинарного де-
   -- рева в ширину
   ------------------------
   breadth lst = brfi lst 0
   --------------------------------
   brfi lst i | i>=length lst = nil
              | True          = node (lst!!i)
                                  (brfi lst (2*i+1))
                                  (brfi lst (2*i+2))
   -------------------------------------------------
   -- Функция возвращает список вершин, полученных в
   -- результате обхода бинарного дерева в ширину
   ---------------------------------------------- 
   masBr tree | isEmpty tree = []
              | True         = [root tree] ++ 
                               uroven tree ++ 
                               masBr1 tree
   ---------------------------------------
   masBr1 tree | isEmpty tree = []
               | True      = uroven (left tree) ++ 
                             uroven (right tree) ++
                             masBr1 (left tree) ++
                             masBr1 (right tree)
   ---------------------------------------------
   uroven tree | isEmpty (left tree) && 
                 isEmpty (right tree) = []
               | isEmpty (left tree)  = [root (right tree)]
               | isEmpty (right tree) = [root (left tree)]
               | True = root (left tree):[root (right tree)]
   -- ******************************************************
   -- Неудачные тестовые примеры:
   ------------------------------
   l1 = map toInt [13]
   l2 = map toInt [13,10]
   l3 = map toInt [13,10,9]
   l4 = map toInt [13,10,9,4]
   l5 = map toInt [13,10,9,4,3]
   l6 = map toInt [13,10,9,4,3,7]
   l7 = map toInt [13,10,9,4,3,7,8]
   l8 = map toInt [13,10,9,4,3,7,8,10,11,12,13,14,15,16,17]
   l9 = map toInt [1..22]
   ----------------------
   tree1 = breadth l1
   tree2 = breadth l2
   tree3 = breadth l3
   tree4 = breadth l4
   tree5 = breadth l5
   tree6 = breadth l6
   tree7 = breadth l7
   tree8 = breadth l8
   tree9 = outTree $ breadth l9
   ----------------------------
   test = writeFile "test.txt" 
          ("Обход бинарного дерева в ширину: "++show l1++"\n"++
           "Дерево: "++show tree1++"\n"++(drawTree tree1 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l2++"\n"++
           "Дерево: "++show tree2++"\n"++(drawTree tree2 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l3++"\n"++
           "Дерево: "++show tree3++"\n"++(drawTree tree3 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l4++"\n"++
           "Дерево: "++show tree4++"\n"++(drawTree tree4 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l5++"\n"++
           "Дерево: "++show tree5++"\n"++(drawTree tree5 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l6++"\n"++
           "Дерево: "++show tree6++"\n"++(drawTree tree6 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l7++"\n"++
           "Дерево: "++show tree7++"\n"++(drawTree tree7 0)++"\n"++
           "\n-------------------------------------------------\n"++
           "Обход бинарного дерева в ширину: "++show l8++"\n"++
           "Дерево: "++show tree8++"\n"++(drawTree tree8 0)++"\n")
   ---------------------------------------------------------------
   test1 = do
             outTree tree1
             putStr ("\n"++ show (masBr tree1))
   test2 = masBr tree2
   test3 = masBr tree3
   test4 = do
             outTree tree8
             putStr ("\n"++ show (masBr tree8))
Файл с примерами можно взять здесь.
   -- Реализация интерпретатора арифметических выражений
   -- [1, с.165-166] 
   -------------------------------
   module ArExpr
   where
   data Expr = Const Int | Id String | App Op Expr Expr
   data Op   = Add | Sub | Mul | Div
   ----------------------------------------------
   -- Функция возвращает значение арифметического
   -- выражения в контексте env
   ------------------------------------
   eval:: Expr -> [(String,Int)] -> Int
   eval (Const x)    _  = x
   eval (Id str)    env = getval str env
   eval (App o x y) env = apply o (eval x env) (eval y env)
   --------------------------------------------------------
   apply:: Op -> Int -> Int -> Int
   apply Add x y = x + y
   apply Sub x y = x - y
   apply Mul x y = x * y
   apply Div x y = div x y
   ------------------------------------------------
   getval _id ((id,value) : xs) | (_id==id) = value
                                | True      = getval _id xs
   -- *****************************************************
   -- Визуализатор арифметических выражений
   ----------------------------------------
   instance Show (Expr) where
      show (Const c)   = show c
      show (Id s)      = s
      show (App o x y) = "(" ++ show o ++ " " ++ 
                                show x ++ " " ++  show y ++ ")"
   ------------------------------------------------------------
   instance Show (Op) where
      show (Add) = "+"
      show (Sub) = "-"
      show (Mul) = "*"
      show (Div) = "/"
   -- ***************************
   -- Неудачные тестовые примеры:
   --------------------------------------------
   test1 = App Sub (App Mul (Const 4) (Id "y"))
                   (App Add (Const 3) (Id "x"))
   --------------------------------------------------
   test2 = eval (App Sub (App Mul (Const 4) (Id "y"))
                         (App Add (Const 3) (Id "x"))
                )
                [("x",4),("y",2)] == 1
Файл с примерами можно взять здесь.
(1)Сергиевский Г.М., Волчёнков Н.Г. Функциональное и логическое программирование. - М.: Издательский центр "Академия", 2010. - 320 с.

    На следующем шаге мы закончим рассмотрение примеров.




Предыдущий шаг Содержание