На этом шаге мы закончим с демонстрационными примерами.
Приведем еще несколько демонстрационных примеров.
-- Модуль, описывающий абстрактный тип данных (АТД), модели- -- рующий числовые бинарные деревья поиска, представленные -- объявлением: -- -- Размеченное объединение -- | -- 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', foldTree',flatten') 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 | null 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: -- (1) в случае успеха возвращает поддерево дерева Tree, в -- котором элемент a является корнем; -- (2) в случае неудачного поиска функция возвращает пустое -- дерево 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 в дереве поиска: -- (1) в случае успеха возвращает True; -- (2) в случае неудачного поиска - 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) [x `mod` a | x <- 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 ------------------------------------------------ -- Моделирование функционала foldl для бинарного -- дерева поиска tree --------------------- foldTree' _ seed Nil = seed foldTree' f seed (Node a tl tr) = foldTree' f (f a (foldTree' f seed tr)) tl ----------------------------------------------------------- -- Моделирование "сглаживания" бинарного дерева поиска tree ----------------------------------------------------------- flatten' tree = foldTree' (:) [] tree
-- Модуль, описывающий абстрактный тип данных (АТД), модели- -- рующий числовые бинарные деревья поиска с ключами, предс- -- тавленные следующим объявлением: -- -- data KBTree = Nil | Node (Int,String) (KBTree) (KBTree) -- -- Автор: И.А.Кудрявцева (28.02.2012) -- ********************************** module TreeK (KBTree (Nil,Node), -------------------------------------------------------- -- Для представления "настоящего" АТД необходимо удалить -- перечень конструкторов данных (Nil,Node) ----------------------------------------------------- nil, list, node, -- Конструкторы root, left, right, -- Селекторы isEmpty, isNode, -- Предикаты ------------------------------------------------- addTree, consTree, consTree', consTree'', delete, ud, delete', ud', klpObh, lpkObh, lkpObh, klkpObh, drawTree, outTree, outTreeD, outTree') where -- Конструктор типа -- | Конструкторы данных -- | | | -- | | | data KBTree = Nil | Node (Int,String) (KBTree) (KBTree) deriving (Eq) -- ******************************* -- Конструкторы данных типа KBTree -- ******************************************* -- Конструктор пустого бинарного дерева поиска ---------------------------------------------- nil:: KBTree nil = Nil -------------------------------------------- -- Конструктор листа бинарного дерева поиска -------------------------------------------- list:: (Int,String) -> KBTree list x = Node x Nil Nil ----------------------------------------------- -- Конструктор вершины бинарного дерева поиска, -- не являющейся листом ------------------------------------------------- node:: (Int,String) -> KBTree -> KBTree -> KBTree node x l r = Node x l r -- **************************** -- Селекторы данных типа KBTree -- ********************************************************** -- Функция-селектор, возвращающая корень дерева поиска KBTree ------------------------------------------------------------- root:: KBTree -> (Int,String) root Nil = error "Дерево пусто" root (Node a l r) = a -------------------------------------------------------- -- Функция-селектор, возвращающая левое поддерево дерева -- поиска KBTree ----------------------- left:: KBTree -> KBTree left Nil = nil left (Node a l r) = l --------------------------------------------------------- -- Функция-селектор, возвращающая правое поддерево дерева -- поиска KBTree ------------------------ right:: KBTree -> KBTree right Nil = nil right (Node a l r) = r -- ************************************************************ -- Предикаты для распознавания конструкторов данных типа KBTree -- (элементов размеченного объединения) -- ******************************************* -- Предикат для распознавания конструктора Nil ---------------------------------------------- isEmpty:: KBTree -> Bool isEmpty Nil = True isEmpty _ = False ----------------------------------------------- -- Предикат для распознавания конструктора Node ----------------------------------------------- isNode:: KBTree -> Bool isNode = not.isEmpty -- ***************************************************** -- Функция, добавляющая элемент x в дерево поиска KBTree -------------------------------------------------------- addTree:: (Int,String) -> KBTree -> KBTree addTree x tree | isEmpty tree = list x | fst x==fst (root tree) = tree | fst x<fst (root tree) = node (root tree) (addTree x (left tree)) (right tree) | True = node (root tree) (left tree) (addTree x (right tree)) ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка lst, элементы которого "поступают" -- в дерево в порядке их следования в списке -------------------------------------------- consTree:: [(Int,String)] -> KBTree consTree lst | lst==[] = nil | True = addTree (last lst) (consTree (init lst)) ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка lst, элементы которого "поступают" -- в дерево в порядке их следования в списке -- (бесточечная запись) ------------------------------------- consTree'':: [(Int,String)] -> KBTree consTree'' = (.) (foldr addTree nil) reverse ----------------------------------------------------------- -- Функция-парсер, конструирующая бинарное дерево поиска из -- одноуровневого списка, элементы которого "поступают" в -- дерево в порядке, обратном их следованию в списке ---------------------------------------------------- consTree':: [(Int,String)] -> KBTree consTree' = foldr addTree nil ------------------------------------------------------------- -- Функция, удаляющая узел x из бинарного дерева поиска tree. -- Функции delete() и ud() "дословно" повторяют соответству- -- ющие рекурсивные процедуры Н.Вирта [1985] (язык Pascal) -- (первый способ) ----------------------------------------- delete:: (Int,String) -> KBTree -> KBTree delete x tree | isEmpty tree = nil | fst x<fst (root tree) = node (root tree) (delete x (left tree)) (right tree) | fst x>fst (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:: KBTree -> (Int,String) ud tree | isEmpty (right tree) = root tree | True = ud (right tree) -------------------------------------------------------- -- Функция, удаляющая узел x из бинарного дерева поиска. -- Функции delete'() и ud'() повторяют соответствующие -- рекурсивные процедуры Н.Вирта [1985] (язык Pascal) -- (второй способ) ------------------------------------------ delete':: (Int,String) -> KBTree -> KBTree delete' x tree | isEmpty tree = nil | fst x<fst (root tree) = node (root tree) (delete' x (left tree)) (right tree) | fst x>fst (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':: KBTree -> (Int,String) ud' tree | isEmpty (left tree) = root tree | True = ud' (left tree) ----------------------------------------------------- -- Функция, осуществляющая левосторонний (нисходящий) -- обход бинарного дерева поиска tree ------------------------------------- klpObh:: KBTree -> [(Int,String)] klpObh tree | isEmpty tree = [] | True = [root tree] ++ klpObh (left tree) ++ klpObh (right tree) ------------------------------------------------------ -- Функция, осуществляющая концевой (восходящий) обход -- бинарного дерева поиска tree --------------------------------- lpkObh:: KBTree -> [(Int,String)] lpkObh tree | isEmpty tree = [] | True = lpkObh (left tree) ++ lpkObh (right tree) ++ [root tree] ----------------------------------------------------- -- Функция, осуществляющая обратный (смешанный) обход -- бинарного дерева поиска tree --------------------------------- lkpObh:: KBTree -> [(Int,String)] lkpObh tree | isEmpty tree = [] | True = lkpObh (left tree) ++ [root tree] ++ lkpObh (right tree) -------------------------------------------------- -- Функция, осуществляющая двойственный обход -- бинарного дерева поиска tree ---------------------------------- klkpObh:: KBTree -> [(Int,String)] klkpObh tree | isEmpty tree = [] | True = [root tree] ++ klkpObh (left tree) ++ [root tree] ++ klkpObh (right tree) -- ************************************************* -- Визуализация бинарного дерева поиска -- ****************************************************** -- Функция, изображающая дерево поиска tree в виде строки -- символов; l - накапливающий параметр, значение которо- -- го при первом вызове функции равно 0 -- (с использованием охран) ---------------------------------- drawTree:: KBTree -> 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 -- (с использованием охран) ----------------------------------- drawTreeD:: KBTree -> Int -> String drawTreeD tree l | isEmpty tree = "" | True = drawTreeD (right tree) (l+1) ++ "\n" ++ replicate (l*3) ' ' ++ show (snd (root tree)) ++ drawTreeD (left tree) (l+1) ------------------------------------------------------------- -- Функция, изображающая дерево поиска tree в виде строки -- символов; l - накапливающий параметр, значение которо- -- го при первом вызове функции равно 0 -- (с использованием сопоставления с образцом) ---------------------------------------------- drawTree':: KBTree -> 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:: KBTree -> IO() outTree tree = putStr (drawTree tree 0 ++ "\n") ---------------------------------------------------- -- Функция, изображающая бинарное дерево поиска tree -- на экране дисплея ------------------------- outTreeD:: KBTree -> IO() outTreeD tree = putStr (drawTreeD tree 0 ++ "\n") ------------------------------------------------------ -- Функция, представляющая бинарное дерево поиска tree -- в виде "обычного" списка, т.е. без указания конст- -- руктора Node ------------------------- outTree':: KBTree -> IO() outTree' tree = putStr (show tree) -------------------------------------------------------- -- Представление типа BTree в качестве экземпляра класса -- Show с определением метода, представляющего бинарное -- дерево поиска без указания имени конструктора Node ----------------------------------------------------- instance Show KBTree 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) ++ ")"
-- Модуль, описывающий абстрактный тип данных (АТД), модели- -- рующий числовые бинарные деревья поиска, представленные -- следующим объявлением: -- -- data LBTree = Nil | Leaf Int | Node LBTree Int LBTree ---------------------------------------------------------- module TreeL (LBTree (Nil,Leaf,Node), -------------------------------------------------------- -- Для представления "настоящего" АТД необходимо удалить -- перечень конструкторов (Nil,Leaf,Node) ----------------------------------------------------- nil, list, node, -- Конструкторы root, left, right, -- Селекторы isEmpty, isLeaf, isNode, -- Предикаты ------------------------------------------------- addTree, drawTree, outTree ------------------------------------ -- Не реализованы следующие функции: ------------------------------------ {- addTree', consTree, consTree'', consTree', search, searchBool, rightList, leftList, delete, ud, delete', ud', top, topNode, nodes, nList, nList', way, equalTree, tCopy, klpObh, lpkObh, lkpObh, klkpObh, newRndTree, mapBTree, filterBT, sort, drawTree, drawTree', outTree, outTree' -} ) where -- Конструктор типа -- | Конструкторы данных -- | | | | -- | | | | data LBTree = Nil | Leaf Int | Node LBTree Int LBTree deriving (Eq) -- ******************************* -- Конструкторы данных типа LBTree -- ******************************************* -- Конструктор пустого бинарного дерева поиска ---------------------------------------------- nil:: LBTree nil = Nil -------------------------------------------- -- Конструктор листа бинарного дерева поиска -------------------------------------------- list:: Int -> LBTree list a = Leaf a ----------------------------------------------- -- Конструктор вершины бинарного дерева поиска, -- не являющейся листом ----------------------------------------- node:: LBTree -> Int -> LBTree -> LBTree node l a r = Node l a r -- **************************** -- Селекторы данных типа LBTree -- ********************************************************** -- Функция-селектор, возвращающая корень дерева поиска LBTree ------------------------------------------------------------- root:: LBTree -> Int root Nil = error "Дерево пусто" root (Leaf a) = a root (Node l a r) = a -------------------------------------------------------- -- Функция-селектор, возвращающая левое поддерево дерева -- поиска LBTree ----------------------- left:: LBTree -> LBTree left Nil = nil left (Leaf a) = nil left (Node l a r) = l --------------------------------------------------------- -- Функция-селектор, возвращающая правое поддерево дерева -- поиска LBTree ------------------------ right:: LBTree -> LBTree right Nil = nil right (Leaf a) = nil right (Node l a r) = r -- ************************************************************ -- Предикаты для распознавания конструкторов данных типа LBTree -- (элементов размеченного объединения) -- ******************************************* -- Предикат для распознавания конструктора Nil ---------------------------------------------- isEmpty:: LBTree -> Bool isEmpty Nil = True isEmpty _ = False ----------------------------------------------- -- Предикат для распознавания конструктора Leaf ----------------------------------------------- isLeaf:: LBTree -> Bool isLeaf (Leaf x) = True isLeaf _ = False ----------------------------------------------- -- Предикат для распознавания конструктора Node ----------------------------------------------- isNode:: LBTree -> Bool isNode tree = (not.isEmpty) tree && (not.isLeaf) tree -- ***************************************************** -- Функция, добавляющая элемент x в дерево поиска LBTree -------------------------------------------------------- addTree:: Int -> LBTree -> LBTree addTree x tree | isEmpty tree = list x | x==root tree = tree | (not.isLeaf) tree = tree | x<root tree = node (addTree x (left tree)) (root tree) (right tree) | True = node (left tree) (root tree) (addTree x (right tree)) -- ********************************************************** -- Визуализация бинарного дерева поиска -- ****************************************************** -- Функция, изображающая дерево поиска tree в виде строки -- символов; l - накапливающий параметр, значение которо- -- го при первом вызове функции равно 0 -- (с использованием охран) ---------------------------------- drawTree:: LBTree -> 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 -- на экране дисплея ------------------------ outTree:: LBTree -> IO() outTree tree = putStr (drawTree tree 0 ++ "\n") ---------------------------------------------------------- -- Представление типа LBTree в качестве экземпляра класса -- Show с определением метода, представляющего бинарное -- дерево поиска без указания имён конструкторов Nil, Leaf -- и Node -------------------- instance Show LBTree where show Nil = "Nil" show (Leaf a) = "(" ++ show a ++ ")" show (Node l a r) = "(" ++ show l ++ " " ++ show a ++ " " ++ show r ++ ")"
На следующем шаге мы приведем перечень задач для самостоятельного решения.
