На этом шаге мы приведем несколько демонстрационных примеров.
Приведем несколько демонстрационных примеров.
; Демонстрация функции, моделирующей операцию "построение ; скошенного бинарного дерева поиска". ; Запуск функции на выполнение: ; ; >muLISP85 SplTree.sys 201-06.LSP ; ; Автор: И.А.Кудрявцева (04.07.2006) ; ---------------------------------- (DEFUN TEST (LAMBDA NIL (PRINT "Построение числового бинарного дерева поиска:") (SETQ Tree NIL) (LOOP (PRIN1 "Введите очередной элемент дерева (окончание !): ") (SETQ X (READ)) ( (EQ X '!) ) (PRINT (SETQ Tree (AddInRoot1 X Tree))) (PRINT "Числовое бинарное дерево поиска:") (PRINT (OutTree Tree 0)) ) )) (RDS)
-- Модуль, описывающий абстрактный тип данных (АТД), модели- -- рующий числовые бинарные деревья поиска, представленные -- следующим объявлением: -- -- data BTree = NIL | Node Int (BTree) (BTree) -- -- Авторы: И.А.Кудрявцева, М.В.Швецкий (15.12.2010)
Раскрыть/скрыть модуль.
--------------------------------------------------- module Tree (BTree (NIL,Node), -------------------------------------------------------- -- Для представления "настоящего" АТД необходимо удалить -- перечень конструкторов данных (NIL,Node) ----------------------------------------------------- nil, list, node, -- Конструкторы root, left, right, -- Селекторы isEmpty, isNode, -- Предикаты ------------------------------------------------- addTree, consTree, consTree', consTree'', search, searchBool, rightList, leftList, delete, ud, delete', ud', top, topNode, nodes, nList, way, equalTree, tCopy, klpObh, lpkObh, lkpObh, klkpObh, newRndTree, sort, mapBTree, filterBT, drawTree, outTree, outTree', -------------------------------------------------- addTree', nList', mapBTree', filterBT', drawTree') where -- Конструктор типа -- | Конструкторы данных -- | | | -- | | | data BTree = NIL | Node Int (BTree) (BTree) deriving (Eq) -- ****************************** -- Конструкторы данных типа BTree -- ******************************************* -- Конструктор пустого бинарного дерева поиска ---------------------------------------------- nil:: BTree nil = NIL -------------------------------------------- -- Конструктор листа бинарного дерева поиска -------------------------------------------- list:: Int -> BTree list x = Node x NIL NIL ----------------------------------------------- -- Конструктор вершины бинарного дерева поиска, -- не являющейся листом ------------------------------------- node:: Int -> BTree -> BTree -> BTree node x l r = Node x l r -- *************************** -- Селекторы данных типа BTree -- ********************************************************* -- Функция-селектор, возвращающая корень дерева поиска BTree ------------------------------------------------------------ root:: BTree -> Int root NIL = error "Дерево пусто" root (Node a l r) = a -------------------------------------------------------- -- Функция-селектор, возвращающая левое поддерево дерева -- поиска BTree --------------------- left:: BTree -> BTree left NIL = nil left (Node a l r) = l --------------------------------------------------------- -- Функция-селектор, возвращающая правое поддерево дерева -- поиска BTree ---------------------- right:: BTree -> BTree right NIL = nil right (Node a l r) = r -- *********************************************************** -- Предикаты для распознавания конструкторов данных типа BTree -- (элементов размеченного объединения) -- ******************************************* -- Предикат для распознавания конструктора NIL ---------------------------------------------- isEmpty:: BTree -> Bool isEmpty NIL = True isEmpty _ = False ----------------------------------------------- -- Предикат для распознавания конструктора Node ----------------------------------------------- isNode:: BTree -> Bool isNode = not.isEmpty -- **************************************************** -- Функция, добавляющая элемент x в дерево поиска BTree ------------------------------------------------------- addTree:: Int -> BTree -> BTree addTree x tree | isEmpty tree = list x | x==root tree = tree | x<root tree = node (root tree) (addTree x (left tree)) (right tree) | True = node (root tree) (left tree) (addTree x (right tree)) ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка lst, элементы которого "поступают" -- в дерево в порядке их следования в списке -------------------------------------------- consTree:: [Int] -> BTree consTree lst | lst==[] = nil | True = addTree (last lst) (consTree (init lst)) ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка lst, элементы которого "поступают" -- в дерево в порядке их следования в списке -- (бесточечная запись) --------------------------- consTree'':: [Int] -> BTree consTree'' = (.) (foldr addTree nil) reverse ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка, элементы которого "поступают" в -- дерево в порядке, обратном их следованию в списке ---------------------------------------------------- consTree':: [Int] -> BTree consTree' = foldr addTree nil ----------------------------------------------------------- -- Функция, осуществляющая поиск элемента a в дереве поиска -- tree: в случае успеха возвращает поддерево дерева Tree, -- в котором элемент a является корнем; в случае неудачного -- поиска функция возвращает пустое дерево nil ---------------------------------------------- search:: Int -> BTree -> BTree search a tree | isEmpty tree = nil | a==root tree = tree | a<root tree = search a (left tree) | True = search a (right tree) ------------------------------------------------------------ -- Функция, осуществляющая поиск элемента a в дереве поиска: -- в случае успеха возвращает True; в случае неудачного по- -- иска - False --------------------------------- searchBool:: Int -> BTree -> Bool searchBool a tree | isEmpty tree = False | a==root tree = True | a<root tree = searchBool a (left tree) | True = searchBool a (right tree) ------------------------------------------------------------- -- Функция, возвращающая самый правый лист дерева поиска tree ------------------------------------------------------------- rightList:: BTree -> Int rightList tree | isEmpty (left tree) && isEmpty (right tree) = root tree | isEmpty (right tree) = rightList (left tree) | True = rightList (right tree) -------------------------------------------------------------- -- Функция, возвращающая самый левый лист дерева поиска tree ------------------------------------------------------------ leftList:: BTree -> Int leftList tree | isEmpty (left tree) && isEmpty (right tree) = root tree | isEmpty (left tree) = leftList (right tree) | True = leftList (left tree) ------------------------------------------------------------- -- Функция, удаляющая узел x из бинарного дерева поиска tree. -- Функции delete() и ud() "дословно" повторяют соответству- -- ющие рекурсивные процедуры Н.Вирта [1985] (язык Pascal) -- (первый способ) ------------------------------ delete:: Int -> BTree -> BTree delete x tree | isEmpty tree = nil | x<root tree = node (root tree) (delete x (left tree)) (right tree) | x>root tree = node (root tree) (left tree) (delete x (right tree)) | isEmpty (right tree) = left tree | isEmpty (left tree) = right tree | True = node (ud (left tree)) (delete (ud (left tree)) (left tree)) (right tree) ------------------------------------------------------- -- Функция, возвращающая самый правый элемент бинарного -- дерева поиска tree --------------------- ud:: BTree -> Int ud tree | isEmpty (right tree) = root tree | True = ud (right tree) -------------------------------------------------------- -- Функция, удаляющая узел x из бинарного дерева поиска. -- Функции delete'() и ud'() повторяют соответствующие -- рекурсивные процедуры Н.Вирта [1985] (язык Pascal) -- (второй способ) ------------------------------- delete':: Int -> BTree -> BTree delete' x tree | isEmpty tree = nil | x<root tree = node (root tree) (delete' x (left tree)) (right tree) | x>root tree = node (root tree) (left tree) (delete' x (right tree)) | isEmpty (right tree) = left tree | isEmpty (left tree) = right tree | True = node (ud' (right tree)) (left tree) (delete' (ud' (right tree)) (right tree)) ------------------------------------------------------- -- Функция, возвращающая самый левый элемент -- бинарного дерева поиска tree ------------------------------- ud':: BTree -> Int ud' tree | isEmpty (left tree) = root tree | True = ud' (left tree) ---------------------------------------------------------- -- Функция, возвращающая количество уровней в бинарном де- -- реве поиска tree (корень дерева расположен на уровне 0) ---------------------------------------------------------- top:: BTree -> Int top tree | isEmpty tree = -1 | True = 1+max (top (left tree)) (top (right tree)) --------------------------------------------------- -- Функция, возвращающая уровень заданной вершины x -- в бинарном дереве поиска tree -------------------------------- topNode:: Int -> BTree -> Int topNode x tree | x==root tree = 0 | x<root tree = 1+ topNode x (left tree) | True = 1+ topNode x (right tree) -------------------------------------------------------- -- Функция, возвращающая количество вершин -- в бинарном дереве поиска tree -------------------------------- nodes:: BTree -> Int nodes tree | isEmpty tree = 0 | True = 1+nodes (left tree) +nodes (right tree) ------------------------------------------------ -- Функция, возвращающая количество листьев -- в бинарном дереве поиска tree -------------------------------- nList:: BTree -> Int nList tree | isEmpty tree = 0 | isEmpty (left tree) && isEmpty (right tree) = 1 | True = nList (left tree)+nList (right tree) ---------------------------------------------------------------- -- Функция, возвращающая количество дуг в бинарном -- дереве поиска tree --------------------- way:: BTree -> Int way tree | isEmpty (left tree) && isEmpty (right tree) = 0 | isEmpty (left tree) = 1+way (right tree) | isEmpty (right tree) = 1+way (left tree) | True = 2+way (left tree) +way (right tree) ---------------------------------------------------- -- Предикат, устанавливающий равенство бинарных -- деревьев поиска tree1 и tree2 ---------------------------------- equalTree:: BTree -> BTree -> Bool equalTree tree1 tree2 | isEmpty tree1 && isEmpty tree2 = True | isEmpty tree1 || isEmpty tree2 = False | True = root tree1==root tree2 && equalTree (left tree1) (left tree2) && equalTree (right tree1) (right tree2) ----------------------------------------------------------- -- Функция, возвращающая копию бинарного дерева поиска tree ----------------------------------------------------------- tCopy:: BTree -> BTree tCopy tree | isEmpty tree = nil | True = node (root tree) (tCopy (left tree)) (tCopy (right tree)) ----------------------------------------------------- -- Функция, осуществляющая левосторонний (нисходящий) -- обход бинарного дерева поиска tree ------------------------------------- klpObh:: BTree -> [Int] klpObh tree | isEmpty tree = [] | True = [root tree] ++ klpObh (left tree) ++ klpObh (right tree) ------------------------------------------------------ -- Функция, осуществляющая концевой (восходящий) обход -- бинарного дерева поиска tree ------------------------------- lpkObh:: BTree -> [Int] lpkObh tree | isEmpty tree = [] | True = lpkObh (left tree) ++ lpkObh (right tree) ++ [root tree] ----------------------------------------------------- -- Функция, осуществляющая обратный (смешанный) обход -- бинарного дерева поиска tree ------------------------------- lkpObh:: BTree -> [Int] lkpObh tree | isEmpty tree = [] | True = lkpObh (left tree) ++ [root tree] ++ lkpObh (right tree) -------------------------------------------------- -- Функция, осуществляющая двойственный обход -- бинарного дерева поиска tree ------------------------------- klkpObh:: BTree -> [Int] klkpObh tree | isEmpty tree = [] | True = [root tree] ++ klkpObh (left tree) ++ [root tree] ++ klkpObh (right tree) ---------------------------------------------------- -- Моделирование функционала map для бинарного -- дерева поиска tree ---------------------------------------- mapBTree:: (Int ->Int) -> BTree -> BTree mapBTree f tree | isEmpty tree = nil | True = node (f (root tree)) (mapBTree f (left tree)) (mapBTree f (right tree)) --------------------------------------------------------------- -- Моделирование функционала filter для бинарного -- дерева поиска tree ------------------------------------------ filterBT:: (Int -> Bool) -> BTree -> [Int] filterBT p tree | isEmpty tree = [] | p (root tree) = [root tree] ++ filterBT p (left tree) ++ filterBT p (right tree) | True = filterBT p (left tree) ++ filterBT p (right tree) -------------------------------------------------------- -- Функция, генерирующая псевдослучайное бинарное дерево -- поиска, содержащее m-n+1 целое число из [0,a-1] -------------------------------------------------- newRndTree:: Int -> Int -> Int -> BTree newRndTree n m a = consTree (newRndLst n m a) where ---------------------------------------------- -- Функция, генерирующая подсписок целых чисел -- -- a ,a ,...,a ,a , -- n n+1 m-1 m -- -- каждое из которых принадлежит [0,a-1], из -- псевдослучайного списка чисел ----------------------------------------------- newRndLst n m a = drop n (take (m+1) (rand' a)) ------------------------------------------------- -- Функция, генерирующая бесконечный список чисел -- из [0,a-1] --------------------------------- rand' a = [x `mod` a | x <- rand] ----------------------------------------------------- -- Функция, генерирующая список псевдослучайных чисел ----------------------------------------------------- rand = iterate next_seed 23765492 ---------------------------------------------- -- Функция, возвращающая псевдослучайное число ---------------------------------------------- next_seed n = case test>0 of True -> test False -> test+2147483647 where test = 48271*lo-3399*hi hi = n `div` 44488 lo = n `mod` 44488 ------------------------------------------------- -- Функция, сортирующая элементы списка с помощью -- бинарного дерева поиска -------------------------- sort:: [Int] -> [Int] sort = lkpObh.consTree -- ************************************ -- Визуализация бинарного дерева поиска -- ****************************************************** -- Функция, изображающая дерево поиска tree в виде строки -- символов; l - накапливающий параметр, значение которо- -- го при первом вызове функции равно 0 -- (с использованием охран) --------------------------------- drawTree:: BTree -> Int -> String drawTree tree l | isEmpty tree = "" | True = drawTree (right tree) (l+1) ++ "\n" ++ replicate (l*3) ' ' ++ show (root tree) ++ drawTree (left tree) (l+1) ----------------------------------------------------------- -- Функция, изображающая дерево поиска tree в виде строки -- символов; l - накапливающий параметр, значение которо- -- го при первом вызове функции равно 0 -- (с использованием сопоставления с образцом) ---------------------------------------------- drawTree':: BTree -> Int -> String drawTree' NIL k = "" drawTree' (Node x l r) k = drawTree' r (k+1) ++ "\n" ++ replicate (k*3) ' ' ++ show x ++ drawTree' l (k+1) ---------------------------------------------------- -- Функция, изображающая бинарное дерево поиска tree -- на экране дисплея ----------------------- outTree:: BTree -> IO() outTree tree = putStr (drawTree tree 0 ++ "\n") ------------------------------------------------------ -- Функция, представляющая бинарное дерево поиска tree -- в виде "обычного" списка, т.е. без указания конст- -- руктора Node ------------------------ outTree':: BTree -> IO() outTree' tree = putStr (show tree) -------------------------------------------------------- -- Представление типа BTree в качестве экземпляра класса -- Show с определением метода, представляющего бинарное -- дерево поиска без указания имени конструктора Node ----------------------------------------------------- instance Show BTree where show tree | isEmpty tree = "Nil" | list (root tree)==tree = "(" ++ show (root tree) ++ " Nil" ++ " Nil" ++ ")" | True = "(" ++ show (root tree) ++ " " ++ show (left tree) ++ " " ++ show (right tree) ++ ")" --**************************************************************** -- Плохие реализации функций с точки зрения АТД -- (с использованием сопоставления с образцом) ------------------------------------------------------- -- Функция, добавляющая элемент x в дерево поиска BTree ------------------------------------------------------- addTree':: Int -> BTree -> BTree addTree' a NIL = list a addTree' a (Node x l r) | a==x = node x l r | a<x = node x (addTree' a l) r | True = node x l (addTree' a r) -------------------------------------------------------- -- Функция, возвращающая количество листьев в бинарном -- дереве поиска --------------------- nList':: BTree -> Int nList' NIL = 0 nList' (Node _ NIL NIL) = 1 nList' (Node _ l r) = nList' l + nList' r ---------------------------------------------- -- Моделирование функционала map для бинарного -- дерева поиска tree ----------------------------------------- mapBTree':: (Int ->Int) -> BTree -> BTree mapBTree' _ NIL = nil mapBTree' f (Node x l r) = node (f x) (mapBTree' f l) (mapBTree' f r) ------------------------------------------------- -- Моделирование функционала filter для бинарного -- дерева поиска tree ------------------------------------------- filterBT':: (Int -> Bool) -> BTree -> [Int] filterBT' p NIL = [] filterBT' p (Node x l r) | p x = [x] ++ filterBT' p l ++ filterBT' p r | True = filterBT' p l ++ filterBT' p r
-- Библиотека для работы со скошенными деревьями -- (Splay Tree). -- Требуется файл Tree.hs (библиотека для работы с -- числовыми бинарными деревьями поиска). -- -- Автор: Кудрявцева И.А. (13.03.2012)
Раскрыть/скрыть модуль.
-------------------------------------- module SplTree (rot_Right, rot_Right', rot_Left, rotInTree, zigZag_R, zigZag_L, zigZig_R, zigZig_L, sparPov, addInRoot, addInRoot1) where import Tree -------------------------------------------------- -- Функции, моделирующие операцию "ротация вправо" -------------------------------------------------- rot_Right:: BTree -> BTree rot_Right tree | isEmpty tree || isEmpty (left tree) = tree | True = node (root (left tree)) (left (left tree)) (node (root tree) (right (left tree)) (right tree)) ------------------------------------------------ rot_Right':: BTree -> BTree rot_Right' NIL = nil rot_Right' (Node q NIL c) = node q nil c rot_Right' (Node q (Node p a b) c) = node p a (node q b c) ------------------------------------------------------------ -- Функция, моделирующая операцию "ротация влево" ------------------------------------------------- rot_Left:: BTree -> BTree rot_Left tree | isEmpty tree || isEmpty (right tree) = tree | True = node (root (right tree)) (node (root tree) (left tree) (left (right tree))) (right (right tree)) --------------------------------------------------------- -- Функция, возвращающая числовое бинарное дерево поиска, -- полученное в результате однократного применения опера- -- ции "ротация", производимой над частью дерева Tree, -- поднимая вершину a на один уровень выше ------------------------------------------ rotInTree:: Int -> BTree -> BTree rotInTree a tree | isEmpty tree = nil | root tree==a = tree | not (isEmpty (left tree)) && root (left tree)==a = rot_Right tree | not (isEmpty (right tree)) && root (right tree)==a = rot_Left tree | True = node (root tree) (rotInTree a (left tree)) (rotInTree a (right tree)) --------------------------------------------------------- -- Функция, моделирующая операцию "спаренный двусторонний -- поворот вправо" ------------------------- zigZag_R:: BTree -> BTree zigZag_R tree | isEmpty tree || isEmpty (right (left tree)) = tree | True = rot_Right (rotInTree (root (right (left tree))) tree) --------------------------------------------------------- -- Функция, моделирующая операцию "спаренный двусторонний -- поворот влево" ------------------------- zigZag_L:: BTree -> BTree zigZag_L tree | isEmpty tree || isEmpty (left (right tree)) = tree | True = rot_Left (rotInTree (root (left (right tree))) tree) ---------------------------------------------------------- -- Функция, моделирующая операцию "спаренный односторонний -- поворот вправо" ------------------------- zigZig_R:: BTree -> BTree zigZig_R tree | isEmpty tree || isEmpty (left (left tree)) = tree | True = rot_Right (rot_Right tree) ---------------------------------------------------------- -- Функция, моделирующая операцию "спаренный односторонний -- поворот влево" ------------------------- zigZig_L:: BTree -> BTree zigZig_L tree | isEmpty tree || isEmpty (right (right tree)) = tree | True = rot_Left (rot_Left tree) --------------------------------------------------------- -- Функция, возвращающая числовое бинарное дерево поиска, -- полученное в результате применения операции "спаренный -- поворот", производимой над частью дерева Tree, корнем -- поддерева которого является вершина a ---------------------------------------- sparPov:: Int -> BTree -> BTree sparPov a tree | isEmpty tree = nil | not (isEmpty (left tree)) && not (isEmpty (right tree)) && (root tree==a || root (left tree)==a || root (right tree)==a) = tree | not (isEmpty (right (left tree))) && root (right (left tree))==a = zigZag_R tree | not (isEmpty (left (right tree))) && root (left (right tree))==a = zigZag_L tree | not (isEmpty (left (left tree))) && root (left (left tree))==a = zigZig_R tree | not (isEmpty (right (right tree))) && root (right (right tree))==a = zigZig_L tree | True = node (root tree) (sparPov a (left tree)) (sparPov a (right tree)) ----------------------------------------------------- -- Функция, моделирующая операцию "включение в корень -- числового бинарного дерева поиска" посредством вы- -- полнения операции "ротация" --------------------------------- addInRoot:: Int -> BTree -> BTree addInRoot x tree | isEmpty tree = node x nil nil | not (isEmpty (left tree)) && x==root (left tree) = rot_Right tree | not (isEmpty (right tree)) && x==root (right tree) = rot_Left tree | search x tree==nil = addInRoot x (addTree x tree) | True = addInRoot x (rotInTree x tree) -------------------------------------------------------- -- Функция, моделирующая операцию "включение в корень -- числового бинарного дерева поиска" посредством при- -- менения операции "спаренный поворот" (и, возможно, -- операции "ротация") ---------------------------------- addInRoot1:: Int -> BTree -> BTree addInRoot1 x tree | isEmpty tree = node x nil nil | x==root tree = tree | not (isEmpty (left tree)) && x==root (left tree) = rot_Right tree | not (isEmpty (right tree)) && x==root (right tree) = rot_Left tree | search x tree==nil = addInRoot1 x (addTree x tree) | True = addInRoot1 x (sparPov x tree)
-- Демонстрация композиции ротаций и поворотов "случайного" -- бинарного дерева поиска с пошаговым выводом промежуточ- -- ных результатов ------------------ import Tree import SplTree ----------------------------- test n m = writeFile "Output" ("Дерево:\n " ++ (drawTree t1 0 ++ "\n\n") ++ "Высота дерева : " ++ show (top t1) ++ "\n" ++ "Идеальная сбалансированность дерева: " ++ show (idTreeP t1) ++ "\n\n" ++ "Результат спаренного поворота вправо:\n" ++ (drawTree t2 0) ++ "\n\n" ++ "Высота нового дерева : " ++ show (top t2) ++ "\n" ++ "Идеальная сбалансированность дерева: " ++ show (idTreeP t2) ++ "\n\n" ++ "Результат ротации влево:\n" ++ (drawTree t3 0) ++ "\n\n" ++ "Высота нового дерева : " ++ show (top t3) ++ "\n" ++ "Идеальная сбалансированность дерева: " ++ show (idTreeP t3) ++ "\n\n" ) where t1 = newRndTree n m 17 t2 = zigZig_R t1 t3 = rot_Left t2 -------------------------------------------------------- -- Предикат, определяющий "идеальную сбалансированность" -- бинарного дерева поиска -------------------------------- idTreeP tree | tree==nil = True | abs (nodes (left tree)-nodes (right tree))>1 = False | True = idTreeP (left tree) && idTreeP (right tree)
На следующем шаге мы приведем перечень задач для самостоятельного решения.
