ababup1192
12/9/2016 - 11:01 PM

bitree.hs

data Tree a = EmptyTree | Node a [Tree a] deriving (Show)

singleton :: a -> Tree a
singleton x = Node x []

treeInsert :: a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a []) = Node a [singleton x]
treeInsert x (Node a cs)
     | length cs < 3 = Node a $ (singleton x) : cs
     | otherwise     = Node a $ foldl (\z c -> treeInsert x c : z) [] cs
    
nums = [1, 2, 3]
numsTree = foldr treeInsert EmptyTree nums

nums2 = [4, 1, 2, 3]
numsTree2 = foldr treeInsert EmptyTree nums2

instance (Eq a) => Eq (Tree a) where
     EmptyTree == EmptyTree = True
     EmptyTree == _ = False
     _ == EmptyTree = False 
     (Node x xcs) == (Node y ycs) = x == y && xcs == ycs

updateTree :: (Eq a) => Tree a -> Tree a -> Tree a
updateTree EmptyTree tree = tree
updateTree _ EmptyTree = EmptyTree
updateTree (Node x xcs) (Node y ycs)
       | x == y && xcs == ycs = Node x xcs
       | xcs == ycs           = Node x xcs
       | otherwise  = 
           let 
               updateChild _ []            = []
               updateChild [] _            = ycs 
               updateChild (x1:xs) (y1:ys) = (updateTree x1 y1) : (updateChild xs ys)
           in
               Node y $ updateChild xcs ycs
           

data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)

singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree

treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
    | x == a = Node x left right
    | x < a  = Node a (treeInsert x left) right
    | x > a  = Node a left (treeInsert x right)

instance (Eq a) => Eq (Tree a) where
    EmptyTree == EmptyTree = True
    EmptyTree == _ = False
    _ == EmptyTree = False 
    (Node x xleft xright) == (Node y yleft yright)
        | x /= y = False
        | x == y = (xleft == yleft) && (xright == yright)


-- *Main> let nums = [8, 1, 6, 3, 1]
-- *Main> let numsTree = foldr treeInsert EmptyTree nums
-- *Main> numsTree == numsTree
-- True
-- \*Main> let nums2 = [8, 2, 0]
-- *Main> let numsTree2 = foldr treeInsert EmptyTree nums2
-- *Main> numsTree == numsTree2
-- False