Improved project structure.

haskell/e018.hs

@@ -0,0 +1,98 @@
+data Tree a = Empty | Node a (Tree a) (Tree a)
+  deriving (Eq, Ord, Show)
+
+leaf :: a -> Tree a
+leaf x = Node x Empty Empty
+
+tree = Node 5 (Node 6 (leaf 8) (leaf 9)) (Node 7 (leaf 10) (leaf 11))
+treeList = [[1], [2, 3], [4, 5, 6], [7, 8, 9, 10]]
+easyList = [[3], [7, 4], [2, 4, 6], [8, 5, 9, 3]]
+
+infiniteTree :: Tree Char
+infiniteTree = Node 'x' infiniteTree infiniteTree
+
+-- breadth first traversal
+bftrav :: Tree a -> [a]
+bftrav = bftrav' . flip (:) []
+  where
+  bftrav' :: [Tree a] -> [a]
+  bftrav' []                = []
+  bftrav' (Empty:xs)        = bftrav' xs
+  bftrav' ((Node x l r):xs) = x:bftrav' (xs ++ l:r:[])
+
+-- breadth first numbering
+bfnum :: Integral a => Tree b -> Tree a
+bfnum t = t'
+  where t':[] = bfnum' 1 [t]
+
+bfnum' :: Integral a => a -> [Tree b] -> [Tree a]
+bfnum' i []                = []
+bfnum' i (Empty:xs)        = Empty:bfnum' i xs
+bfnum' i ((Node x l r):xs) = (Node i l' r'):(reverse xs')
+  where r':l':xs' = reverse $ bfnum' (i+1) (xs ++ l:r:[])
+  --where xs':l':r' = bfnum' (i+1) (xs ++ l:r:[])
+
+bfinsert' :: Maybe a -> [Tree a] -> [Tree a]
+bfinsert' _ []                = []
+bfinsert' (Just x) (Empty:ts) = (leaf x):bfinsert' Nothing ts
+bfinsert' Nothing (Empty:ts)  = Empty:bfinsert' Nothing ts
+bfinsert' x ((Node y l r):ts) = (Node y l' r'):(reverse ts')
+  where r':l':ts' = reverse $ bfinsert' x (ts ++ l:r:[])
+
+fromList :: [a] -> Tree a
+fromList = head . foldl (flip bfinsert') [Empty] . map Just
+
+parseToLists :: String -> [[Integer]]
+parseToLists = map (map read . words) . lines
+
+getLeft :: [[a]] -> [[a]]
+getLeft = map init
+
+getRight :: [[a]] -> [[a]]
+getRight = map tail 
+
+bfdepth :: [[a]] -> Tree a
+bfdepth []          = Empty
+bfdepth ((x:[]):xs) = Node x (bfdepth . getLeft $ xs) (bfdepth . getRight $ xs)
+
+fromLists :: [[a]] -> Tree a
+fromLists = bfdepth
+
+easyTree = fromLists easyList
+
+getPotential :: Integral a => Tree a -> a
+getPotential Empty        = 0
+getPotential (Node x l r) = x + max (getPotential l) (getPotential r)
+
+getHeight :: Tree a -> Int
+getHeight Empty        = 0
+getHeight (Node _ t _) = 1 + getHeight t
+
+maxLeft :: [[Integer]] -> [Integer]
+maxLeft []     = []
+maxLeft [x]    = [maximum x]
+maxLeft (x:xs) = let ms = maxLeft xs in (maximum x + head ms):ms
+
+type Current  = Integer
+type MaxFound = Integer
+type State    = (Current, MaxFound)
+
+findMaxPath :: [Integer] -> State -> Tree Integer -> State
+findMaxPath _ (c, m) (Node x Empty Empty) = if c + x > m then (c, c + x) else (c, m)
+findMaxPath (p:ps) (c, m) (Node x l@(Node xl _ _) r@(Node xr _ _))
+  | c + p <= m = (c, m)
+  | otherwise  = (c, m'')
+    where
+    (_, m')  = (findMaxPath ps (c + x, m) l) 
+    (_, m'') = if m' < c + p then 
+                 if m' > m then (findMaxPath ps (c + x, m') r) else (findMaxPath ps (c + x, m) r)
+                 else (c, m')
+
+
+main = do
+  s <- readFile "67.txt"
+  let l = parseToLists s
+  let t = fromLists l
+  let m = maxLeft l
+  let p = putStrLn . show
+  p $ findMaxPath m (0, 0) t