finish vol 7

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