52 lines
1.6 KiB
Haskell
52 lines
1.6 KiB
Haskell
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)
|
|
|
|
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
|