Haskell 07 [PDF]

Zitiervorschau

{-# OPTIONS_GHC -Wall #-} module Haskell07 where import Data.List(sort) data BinTreeM a = EmptyM | NodeM a Int (BinTreeM a) (BinTreeM a) deriving (Show, Eq) -- B-äåðåâî ïîðÿäêà t (NodeB kl tl) => -t-1 BinTreeM a -> Bool compareV _ (EmptyM) (EmptyM) = True compareV vv (EmptyM) (NodeM vr _ _ _) = vv < vr compareV vv (NodeM vl _ _ _) (EmptyM) = vv > vl compareV vv (NodeM vl _ _ _) (NodeM vr _ _ _) = vv > vl && vv < vr -- Çàäà÷à 2 -----------------------------------elemSearch :: (Ord a) => BinTreeM a -> a -> Bool elemSearch EmptyM _ = False elemSearch (NodeM v _ bl br) val | v == val = True | val < v = elemSearch bl val | otherwise = elemSearch br val -- Çàäà÷à 3 -----------------------------------insSearch :: (Ord a) => BinTreeM a -> a -> BinTreeM a insSearch EmptyM val = NodeM val 1 EmptyM EmptyM insSearch (NodeM v k bl br) val | val == v = NodeM v (k+1) bl br | val < v = NodeM v k (insSearch bl val) br | otherwise = NodeM v k bl (insSearch br val) -- Çàäà÷à 4 -----------------------------------delSearch :: (Ord a) => BinTreeM a -> a -> BinTreeM a delSearch EmptyM _ = EmptyM delSearch (NodeM v k EmptyM EmptyM) val --leaf | val == v && k > 1 = NodeM v (k-1) EmptyM EmptyM | otherwise = EmptyM delSearch (NodeM v k EmptyM br) val --one child right | val == v && k > 1 = NodeM v (k-1) EmptyM br | val == v && k == 1 = br | val > v = NodeM v k EmptyM (delSearch br val) | otherwise = NodeM v k EmptyM br delSearch (NodeM v k bl EmptyM) val --one child left | val == v && k > 1 = NodeM v (k-1) bl EmptyM | val == v && k == 1 = bl | val > v = NodeM v k bl EmptyM | otherwise = NodeM v k (delSearch bl val) EmptyM delSearch curr@(NodeM v k bl br) val --two childs | val == v && k > 1 = NodeM v (k-1) bl br

| val > v = NodeM v k bl (delSearch br val) | val < v = NodeM v k (delSearch bl val) br | otherwise = let inSucc = inorderSuccessor br --leftmost value bigger than current value where inorderSuccessor :: BinTreeM a -> BinTreeM a inorderSuccessor EmptyM = error "Right undertree can't be empty" inorderSuccessor (NodeM sv sk EmptyM EmptyM) = NodeM sv sk EmptyM EmptyM inorderSuccessor (NodeM sv sk EmptyM sbr) = NodeM sv sk EmptyM sbr inorderSuccessor (NodeM _ _ sbl _) = inorderSuccessor sbl succDel :: (Ord a) => BinTreeM a -> BinTreeM a -> BinTreeM a -- succ| curr succDel EmptyM _ = error "Inorder Successor can't be empty" succDel _ EmptyM = error "Input tree can't be empty" succDel (NodeM _ _ (NodeM _ _ _ _) _) _ = error "InordSuccessor can't have left child" succDel (NodeM svv skk EmptyM _) (NodeM _ _ cbl cbr) = NodeM svv skk cbl $ until cond step cbr where --cond :: BinTreeM a -> Bool cond tree = not (elemSearch tree svv) --step :: BinTreeM a -> BinTreeM a step ctree = delSearch ctree svv in succDel inSucc curr -- Çàäà÷à 5 -----------------------------------sortList :: (Ord a) => [a] -> [a] sortList [] = [] sortList xs = let tree = foldl insSearch EmptyM xs symGoThrough :: (Ord a) => BinTreeM a -> [a] symGoThrough EmptyM = [] symGoThrough (NodeM x k l r) = symGoThrough l ++ (multiCopy x k) ++ symGoThrough r in symGoThrough tree multiCopy multiCopy multiCopy multiCopy

:: (Ord _ 0 = val 1 = val k =

a) => a -> Int -> [a] [] [val] [val] ++ multiCopy val (k-1)

-- Çàäà÷à 6 -----------------------------------findBInform :: (Bounded a, Ord a) => Btree a -> BInform a findBInform (NodeB [] _) = error "Key list can't be empty" findBInform (NodeB ks []) = BInform 0 (head ks) (last ks) findBInform t = BInform (height t) (lm t) (rm t) where height :: Btree a -> Int height (NodeB _ []) = 0 height (NodeB _ ts) = 1 + (height $ head ts) lm :: Btree a -> a lm (NodeB (k:_) []) = k lm (NodeB _ ts) = lm $ head ts rm :: Btree a -> a rm (NodeB ks []) = last ks rm (NodeB _ ts) = rm $ last ts -- Çàäà÷à 7 ------------------------------------

------

B-äåðåâî ïîðÿäêà t (NodeB kl tl) => t-1 = 1 && n Btree a -> Bool --4 checkNodesSort (NodeB kks tts) = isSorted kks && checkAllNodesSort tts where checkAllNodesSort [] = True checkAllNodesSort (x:xs) = checkNodesSort x && checkAllNodesSort xs checkNodesKeysLength :: [Btree a] -> Bool --1 checkNodesKeysLength [] = True checkNodesKeysLength ((NodeB kkks ttts):xs) = (kn = (t-1)) && (checkNodesKeysLength ttts) && (checkNodesKeysLength xs) where kn = length kkks checkKeysRange (NodeB krs trs) = (checkKeySetRange krs trs) && (checkKeysRangeAll trs) where checkKeysRangeAll [] = True checkKeysRangeAll (x:xxxs) = (checkKeysRange x) && (checkKeysRangeAll xxxs) checkKeySetRange [] _ = True checkKeySetRange _ [] = True checkKeySetRange (kk:kkrs) (tt:ttrs) = (checkSingleKeyRange kk (tt)) && (checkKeySetRange kkrs ttrs) checkSingleKeyRange kkk (NodeB nbk _) = null $ filter (\z -> z > kkk) nbk isSorted isSorted isSorted isSorted

:: (Ord a) [] = [_] = (x:y:xs) =

=> [a] -> Bool True True x Int -> Btree a -> Btree a -> Bool eqBtree _ f s = sort (treeToString f) == sort (treeToString s) treeToString :: Btree a -> [a] treeToString (NodeB keys strees) = keys ++ (concatMap treeToString strees) -- Çàäà÷à 9 -----------------------------------elemBtree :: Ord a => Btree a -> a -> Bool elemBtree t x = elem x $ treeToString t position :: Ord a => a -> [a] -> Int position v xs = case [ind | (ind, x) x

-- Çàäà÷à 10 -----------------------------------insBtree :: Ord a => Int -> Btree a -> a -> Btree a insBtree t tree v | (isFull t tree) = let (lt, uk, rt) = splitAtB t tree in insertIntoNode t (NodeB [uk] [lt,rt]) v | otherwise = insertIntoNode t tree v isFull :: Ord a => Int -> Btree a -> Bool isFull t (NodeB ks _ ) = length ks == 2*t-1 insertIntoNode :: Ord a => Int -> Btree a -> a -> Btree a insertIntoNode _ (NodeB ks []) v = NodeB (insertKey v ks) [] insertIntoNode t (NodeB ks ts) v = let (kl1,kl2,tl1,bt,tl2) = decomposeNodeB v ks ts in if (isFull t bt) then let (bt1,k,bt2) = splitAtB t bt btr1 = if v [a] -> [a] insertKey v [] = [v] insertKey v (x:xs) | v a -> [a] -> [Btree a] -> ([a], [a], [Btree a], Btree a, [Btree a]) decomposeNodeB v ks ts = let pos = position v ks tl1 = [ts!!ti | ti