[99p]Binary(Complete w/o #66)

import Data.List

----- data structure of tree
data Tree a = Empty | Branch a (Tree a) (Tree a)
              deriving (Show, Eq)

-- problem 55
cbTree :: Int -> [Tree Char]
cbTree 0 = [Empty]
cbTree n = [Branch 'x' lt rt | i <- [q..q+r], lt <- cbTree i, rt <- cbTree (n-1-i)]
           where (q, r) = ((n-1) `div` 2, (n-1) `mod` 2)

-- problem 56
mirror :: Tree a -> Tree a -> Bool
mirror Empty Empty = True
mirror (Branch _ lt1 rt1) (Branch _ lt2 rt2) = mirror lt1 rt2 && mirror lt2 rt1
mirror _ _ = False
symmetric :: Tree a -> Bool
symmetric Empty = True
symmetric (Branch _ lt rt) = mirror lt rt

-- problem 57
add' :: Ord a => a -> Tree a -> Tree a
add' x Empty = Branch x Empty Empty
add' x (Branch y lt rt)
    | x == y  = Branch y lt rt
    | x < y   = Branch y (add' x lt) rt
    | x > y   = Branch y lt (add' x rt)
createbst :: Ord b => [b] -> Tree b
createbst xs = foldr (add') Empty $ reverse xs

-- problem 58
symcbTree n = filter symmetric $ cbTree n

-- problem 59
hbhTree :: Int -> [Tree Char]
hbhTree 0 = [Empty]
hbhTree 1 = [Branch 'x' Empty Empty]
hbhTree n = [Branch 'x' lt rt |
             hl <- [n-2..n-1], hr <- [n-2..n-1], lt <- hbhTree hl, rt <- hbhTree hr, max hl hr == n-1]
-- problem 60
----- predefined funcs
nodecount :: Tree Char -> Int
nodecount Empty = 0
nodecount (Branch _ lt rt) = 1 + nodecount lt + nodecount rt
height :: Tree Char -> Int
height Empty = 0
height (Branch _ lt rt) = 1 +  max (height lt) (height rt)
----- pre-guessed(minNode,maxHeight) funcs
minNode :: Int -> Int
minNode 0 = 0
minNode 1 = 1
minNode n = minNode (n-1) + minNode (n-2) + 1
maxNode :: Int -> Int
maxNode n = 2^n - 1
minHeight :: Int -> Int
minHeight n = ceiling $ logBase 2 $ fromIntegral(n+1)
maxHeight :: Int -> Int
maxHeight n = (head $filter (\x -> minNode x > n) [1..]) - 1
----- very slow solution
hbnTree :: Int -> [Tree Char]
hbnTree 0 = [Empty]
hbnTree n = [Branch 'x' lt rt |
             i <- [0..n-1], lt <- hbnTree i, rt <- hbnTree (n-1-i), abs(height lt - height rt) < 2]
----- a quick solution
hbnTree' :: Int -> [Tree Char]
hbnTree' 0 = [Empty]
hbnTree' n = concat $ map (filter (\x ->nodecount x == n) . hbhTree) [(minHeight n)..(maxHeight n)]

-- predefined tree4
tree4 = Branch 1 (Branch 2 Empty (Branch 4 Empty Empty))
                 (Branch 2 Empty Empty)

-- problem 61
leafcount :: Tree a -> Int
leafcount Empty = 0
leafcount (Branch _ Empty Empty) =1
leafcount (Branch _ lt rt) = leafcount lt + leafcount rt

-- problem 61a
leaflist :: Tree a -> [a]
leaflist Empty = []
leaflist (Branch a Empty Empty) = [a]
leaflist (Branch _ lt rt) = leaflist lt ++ leaflist rt

-- problem 62
internallist :: Tree a -> [a]
internallist Empty = []
internallist (Branch _ Empty Empty) = []
internallist (Branch a lt rt) = [a] ++ internallist lt ++ internallist rt

-- problem 62a
atLevel :: Tree a -> Int -> [a]
atLevel _ 0 = []
atLevel Empty _ = []
atLevel (Branch a _ _) 1 = [a]
atLevel (Branch _ lt rt) n = atLevel lt (n-1) ++ atLevel rt (n-1)

-- problem 63
cbinHeight :: Int -> Int
cbinHeight n = ceiling $ logBase 2 $ fromIntegral(n+1)
cbinTree :: Int -> Tree Char
cbinTree 0 = Empty
cbinTree 1 = Branch 'x' Empty Empty
cbinTree n = Branch 'x' (cbinTree ltn) (cbinTree rtn)
             where (ltn, rtn)
                    | (n-1) < 3*2^(h-2)-1  = (n-2^(h-2), 2^(h-2)-1)
                    | (n-1) >= 3*2^(h-2)-1  = (2^(h-1)-1 , n-2^(h-1))
                    where h = cbinHeight n
cmpTree :: Tree Char -> Tree Char -> Bool
cmpTree Empty Empty = True
cmpTree (Branch _ lt rt) Empty = False
cmpTree Empty (Branch _ lt rt) = False
cmpTree (Branch _ lt1 rt1) (Branch _ lt2 rt2) = (cmpTree lt1 lt2) && (cmpTree rt1 rt2)
iscbinTree :: Tree Char -> Bool
iscbinTree t = cmpTree t (cbinTree $nodecount t)

-- predefined tree64
tree64 = Branch 'n'
                (Branch 'k'
                        (Branch 'c'
                                (Branch 'a' Empty Empty)
                                (Branch 'h'
                                        (Branch 'g'
                                                (Branch 'e' Empty Empty)
                                                Empty
                                        )
                                        Empty
                                )
                        )
                        (Branch 'm' Empty Empty)
                )
                (Branch 'u'
                        (Branch 'p'
                                Empty
                                (Branch 's'
                                        (Branch 'q' Empty Empty)
                                        Empty
                                )
                        )
                        Empty
                )
-- problem 64
layouta' :: Int -> Tree Char -> Tree (Char, (Int, Int))
layouta' _ Empty  = Empty
layouta' n (Branch a lt rt)  = Branch (a, (horia, n)) (layouta' (n+1) lt) (layouta' (n+1) rt)
                               where horia = nodecount lt +1
layouta :: Tree Char -> Tree (Char, (Int, Int))
layouta = layouta' 1

-- predefined tree65
tree65 = Branch 'n'
                (Branch 'k'
                        (Branch 'c'
                                (Branch 'a' Empty Empty)
                                (Branch 'e'
                                        (Branch 'd' Empty Empty)
                                        (Branch 'g' Empty Empty)
                                )
                        )
                        (Branch 'm' Empty Empty)
                )
                (Branch 'u'
                        (Branch 'p'
                                Empty
                                (Branch 'q' Empty Empty)
                        )
                        Empty
                )
-- problem 65
mostleftDepth :: Tree a -> Int
mostleftDepth Empty = 0
mostleftDepth (Branch _ lt rt) = 1+ mostleftDepth lt
layoutb' :: Int -> Int -> Int -> Tree Char -> Tree (Char, (Int, Int))
layoutb' _ _ _ Empty  = Empty
layoutb' m n d (Branch a lt rt) = Branch (a,(m+2^d, n)) (layoutb' m (n+1) (d-1) lt) (layoutb' (m+2^d) (n+1) (d-1) rt)
layoutb'' t = layoutb' 0 1 (height t -1) t
parahorileft :: Int -> Tree (Char, (Int, Int)) -> Tree (Char, (Int, Int))
parahorileft _ Empty = Empty
parahorileft 0 t = t
parahorileft n (Branch (a, (hori, verti)) lt rt) = Branch (a, (hori -n, verti)) (parahorileft n lt) (parahorileft n rt)
layoutb :: Tree Char -> Tree (Char, (Int, Int))
layoutb t = parahorileft (if (height t == mostleftDepth t) then 0 else 2^(height t - mostleftDepth t -1) ) $layoutb'' t

-- predefined tree66
tree66 = Branch 'n'
                (Branch 'k'
                        Empty
                        (Branch 'm' Empty Empty)
                )
                (Branch 'u'
                        Empty
                        (Branch 'p' Empty Empty)
                )


-- problem 66

-- problem 67a
treeStr :: Tree Char -> String
treeStr Empty = ""
treeStr (Branch a Empty Empty) = [a]
treeStr (Branch a lt rt) = [a] ++ "(" ++ treeStr lt ++ "," ++ treeStr rt ++ ")"
countparaLeft :: String -> Int
countparaLeft [] = 0
countparaLeft xs = length $ findIndices (=='(') xs
countparaRight :: String -> Int
countparaRight [] = 0
countparaRight xs = length $ findIndices (==')') xs
spSearch :: String -> Int
spSearch xs = head [i | i <- findIndices (==',') xs, countparaLeft (take i xs) == countparaRight (take i xs)]
strTree :: String -> Tree Char
strTree "" = Empty
strTree [a] = Branch a Empty Empty
strTree (a:y:xs)
        | y == '(' && last xs == ')' = Branch a (strTree $ take sp xxs) (strTree $ drop (sp+1) xxs)
                                       where xxs = init xs
                                             sp = spSearch xxs

-- problem 68
treePre :: Tree Char -> String
treePre Empty = ""
treePre (Branch a lt rt) = [a] ++ treePre lt ++ treePre rt
treeIn :: Tree Char -> String
treeIn Empty = ""
treeIn (Branch a lt rt) = treeIn lt ++ [a] ++ treeIn rt
preTree :: String -> Tree Char
preTree "" = Empty
preTree [a] = Branch a Empty Empty
preTree (x:xs) = Branch x Empty (preTree xs)
preinTree :: String -> String -> Tree Char
preinTree "" "" = Empty
preinTree [a] [b]
          | a == b     = Branch a Empty Empty
          | a /= b     = error "dont kidding me"
preinTree (x:xs) ys
          | sort (x:xs) /= sort ys  = error "dont kidding me"
          | sort (x:xs) == sort ys  = Branch x lt rt
                         where lt = preinTree (take sp xs) (take sp ys)
                               rt = preinTree (drop sp xs) (drop (sp+1) ys)
                               sp = head $ findIndices (==x) ys

-- problem 69
treeDots :: Tree Char -> String
treeDots Empty = "."
treeDots (Branch a lt rt) = [a] ++ treeDots lt ++ treeDots rt
dotsnodots :: String -> Int
dotsnodots "" = 0
dotsnodots (x:xs) = (if x=='.' then 1 else (-1)) + dotsnodots(xs)
dotsTree :: String -> Tree Char
dotsTree "" = Empty
dotsTree "." = Empty
dotsTree (x:xs) = Branch x (dotsTree $ take dp xs) (dotsTree $ drop dp xs)
                  where dp = head $ findIndices (==1) $ map dotsnodots (inits xs)