На этом шаге мы приведем несколько примеров использования бинарных деревьев.
Приведем несколько демонстрационных примеров.
-- Демонстрация работы с "отцами" и "сыновьями" -- в бинарных деревьях поиска -- ************************** 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 с.
На следующем шаге мы закончим рассмотрение примеров.
