diff options
| -rw-r--r-- | 61-69/66.hs | 17 | ||||
| -rw-r--r-- | 61-69/67.hs | 30 | ||||
| -rw-r--r-- | 61-69/68.hs | 35 | ||||
| -rw-r--r-- | 61-69/69.hs | 14 |
4 files changed, 96 insertions, 0 deletions
diff --git a/61-69/66.hs b/61-69/66.hs new file mode 100644 index 0000000..8a3f69c --- /dev/null +++ b/61-69/66.hs @@ -0,0 +1,17 @@ +data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq) + +layout :: Tree Char -> Tree (Char, (Int, Int)) + +-- layout': the second component of result is the distance of left edge to the +-- axis of root, and the thrid is the distance of right edge. + +layout t = let (ret, ld, _) = layout' t x0 1 + x0 = 1 + maximum ld in ret + where layout' :: Tree Char -> Int -> Int -> (Tree (Char, (Int, Int)), [Int], [Int]) + layout' Empty x y = (Empty, [], []) + layout' (Branch v l r) x y = (Branch (v, (x, y)) lt rt, ld, rd) + where (lt, lld, lrd) = layout' l (x - hsep) (y + 1) + (rt, rld, rrd) = layout' r (x + hsep) (y + 1) + hsep = 1 + (maximum $ 0:zipWith (+) lrd rld) `div` 2 + ld = 0:map (+ hsep) lld + rd = 0:map (+ hsep) rrd diff --git a/61-69/67.hs b/61-69/67.hs new file mode 100644 index 0000000..70186f1 --- /dev/null +++ b/61-69/67.hs @@ -0,0 +1,30 @@ +data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq) + +treeToString :: Tree Char -> [Char] + +treeToString Empty = "" +treeToString (Branch x Empty Empty) = [x] +treeToString (Branch x l r) = x:'(':(treeToString l) ++ "," ++ (treeToString r) ++ ")" + +stringToTree :: Monad m => [Char] -> m (Tree Char) + +stringToTree "" = return (Empty) +stringToTree [x] = return (Branch x Empty Empty) +stringToTree x = fmap fst $ parse x + where parse (x:xs) + | x == ',' || x == ')' = return (Empty, x:xs) + parse (x:y:xs) + | y == ',' || y == ')' = return (Branch x Empty Empty, y:xs) + | y == '(' = do (lt, ',':xs') <- parse xs + (rt, ')':xs'') <- parse xs' + return (Branch x lt rt, xs'') + parse _ = fail "parse error" + + +cbtFromList :: [a] -> Tree a + +cbtFromList xs = let (t, xss) = cbt (xs:xss) in t + where cbt ((x:xs):xss) = (Branch x lt rt, xs:xss'') + where (lt, xss') = cbt xss + (rt, xss'') = cbt xss' + cbt _ = (Empty, []) diff --git a/61-69/68.hs b/61-69/68.hs new file mode 100644 index 0000000..741795b --- /dev/null +++ b/61-69/68.hs @@ -0,0 +1,35 @@ +data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq) + +stringToTree :: Monad m => [Char] -> m (Tree Char) + +stringToTree "" = return (Empty) +stringToTree [x] = return (Branch x Empty Empty) +stringToTree x = fmap fst $ parse x + where parse (x:xs) + | x == ',' || x == ')' = return (Empty, x:xs) + parse (x:y:xs) + | y == ',' || y == ')' = return (Branch x Empty Empty, y:xs) + | y == '(' = do (lt, ',':xs') <- parse xs + (rt, ')':xs'') <- parse xs' + return (Branch x lt rt, xs'') + parse _ = fail "parse error" + +treeToPreorder :: Tree Char -> [Char] + +treeToPreorder Empty = "" +treeToPreorder (Branch x l r) = x:treeToPreorder l ++ treeToPreorder r + +treeToInorder :: Tree Char -> [Char] + +treeToInorder Empty = "" +treeToInorder (Branch x l r) = treeToInorder l ++ [x] ++ treeToInorder r + + +preInTree :: Monad m => [Char] -> [Char] -> m (Tree Char) +preInTree [] [] = return Empty +preInTree (p:ps) is = do let (lis, _:ris) = break (== p) is + (lps, rps) = splitAt (length lis) ps + lt <- preInTree lps lis + rt <- preInTree rps ris + return $ Branch p lt rt +preInTree _ _ = fail "error" diff --git a/61-69/69.hs b/61-69/69.hs new file mode 100644 index 0000000..63c75b0 --- /dev/null +++ b/61-69/69.hs @@ -0,0 +1,14 @@ +data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq) + +ds2tree :: [Char] -> Tree Char + +ds2tree l = fst $ build l + where build ('.':xs) = (Empty, xs) + build (x:xs) = (Branch x lt rt, xs'') + where (lt, xs') = build xs + (rt, xs'') = build xs' + +tree2ds :: Tree Char -> [Char] + +tree2ds Empty = "." +tree2ds (Branch x l r) = x:tree2ds l ++ tree2ds r |