99 lines
2.9 KiB
Haskell
99 lines
2.9 KiB
Haskell
|
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
|