day 7

07/solution.hs

@@ -0,0 +1,55 @@
+import Debug.Trace
+import Data.List
+import Data.Maybe
+import Data.Array
+
+traceOut :: Show a => a -> a
+traceOut x = traceShow x x
+
+(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
+(f *** g) (x, y) = (f x, g y)
+
+(****) :: (a -> a' -> a'') -> (b -> b' -> b'') -> (a, b) -> (a', b') -> (a'', b'')
+(f **** g) (p, q) (r, s) = (f p r, g q s)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = (x : y) : ys
+
+split :: Eq a => [a] -> [a] -> [[a]]
+split _ [] = []
+split delims (x:xs)
+  | x `elem` delims = [] : split delims xs
+  | otherwise       = addFirst (split delims xs) x
+
+enumerate :: [a] -> [(Int, a)]
+enumerate = zip [0..]
+
+parseFile :: String -> ([Int], [[Int]])
+parseFile = ((elemIndices 'S') *** (filter (not . null) . map (elemIndices '^'))) . fromJust . uncons . split ['\n']
+
+solve1 :: ([Int], [[Int]]) -> Int
+solve1 (xs, yss) = sum $ map fst $ scanl (\(_, xs') ys -> (sum *** (nub . concat)) $ unzip $ map (\x -> if x `elem` ys then (1, [x-1, x+1]) else (0, [x])) xs') (0, xs) yss
+
+solve2 :: ([Int], [[Int]]) -> Int
+solve2 (xs, yss) = sum $ map (\x -> (timelineArray yss) ! (x, 0)) xs
+
+timelineArray :: [[Int]] -> Array (Int, Int) Int
+timelineArray yss = fromFunc ((0, 0), (1 + (foldl max 0 $ map (foldl max 0) $ yss), length yss)) (uncurry timelines)
+    where
+  arr = timelineArray yss
+  timelines x y
+    | length yss <= y   = 1
+    | x `elem` (yss!!y) = (arr ! (x-1, y+1)) + (arr ! (x+1, y+1))
+    | otherwise         = arr ! (x, y+1)
+
+fromFunc :: Ix i => (i, i) -> (i -> e) -> Array i e
+fromFunc (a, b) f = array (a, b) [(x, f x) | x <- range (a, b)]
+
+main = do 
+    fileinp <- readFile "input.txt"
+    let input = parseFile fileinp
+    let solved1 = solve1 input
+    let solved2 = solve2 input
+    print solved1
+    print solved2