day 10

10/solution.hs

@@ -0,0 +1,64 @@
+import Data.List
+import Data.Graph
+import Data.Maybe
+import Debug.Trace
+
+traceOut :: Show a => a -> a
+traceOut x = (traceShow x x)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = ([x] ++ y) : ys
+
+split :: [Char] -> String -> [String]
+split _ [] = []
+split delims (x:xs)
+  | elem x delims = [[]] ++ split delims xs
+  | otherwise     = addFirst (split delims xs) x
+
+splitInput :: String -> [[Int]]
+splitInput = map (map (\x -> read [x])) . split ['\n']
+
+makeGraph :: [[Int]] -> (Graph, (Vertex -> (Int, (Int, Int), [(Int, Int)])), ((Int, Int) -> Maybe Vertex))
+makeGraph grid = graphFromEdgeList grid . concat . map (\(x, _) -> x) . concat . flipSecond . map (map (\(x, row) -> foldl' (combine x) ([], (-1, -2)) row)) . map (indexed . map indexed) . (\x -> [x, transpose x]) $ grid
+
+graphFromEdgeList :: [[Int]] -> [((Int, Int), (Int, Int))] -> (Graph, (Vertex -> (Int, (Int, Int), [(Int, Int)])), ((Int, Int) -> Maybe Vertex))
+graphFromEdgeList grid edgePairs = 
+    graphFromEdges [(value, (x, y), [b | (a, b) <- edgePairs, a == (x, y)]) | (x, row) <- indexed grid, (y, value) <- indexed row] 
+
+combine :: Int -> ([((Int, Int), (Int, Int))], (Int, Int)) -> (Int, Int) -> ([((Int, Int), (Int, Int))], (Int, Int))
+combine x (edges, (prevy, prevv)) (nexty, nextv)
+  | nextv == prevv + 1 = ((((x, prevy), (x, nexty)):edges), (nexty, nextv))
+  | nextv == prevv - 1 = ((((x, nexty), (x, prevy)):edges), (nexty, nextv))
+  | otherwise          = (edges, (nexty, nextv))
+
+indexed :: [a] -> [(Int, a)]
+indexed xs = zip [0..] xs
+
+flipSecond :: [[([((Int, Int), (Int, Int))], (Int, Int))]] -> [[([((Int, Int), (Int, Int))], (Int, Int))]]
+flipSecond [a, xs] = [a,  map (\(x, y) -> ((map (\((a, b), (c, d)) -> ((b, a), (d, c))) x), y)) xs]
+
+solve1 :: Graph -> (Vertex -> (Int, (Int, Int), [(Int, Int)])) -> Int
+solve1 graph gfunc = length . concat . map (filter (\v -> let (a, _, _) = gfunc v in a == 9) . reachable graph) $ verticesWhereEq graph gfunc 0
+
+solve2 :: Graph -> (Vertex -> (Int, (Int, Int), [(Int, Int)])) -> ((Int, Int) -> Maybe Vertex) -> Int
+solve2 graph gfunc gfunc2 = sum . concat . map (\v0 -> map (\v9 -> paths graph gfunc gfunc2 v0 v9) (verticesWhereEq graph gfunc 9)) $ verticesWhereEq graph gfunc 0
+
+paths :: Graph -> (Vertex -> (Int, (Int, Int), [(Int, Int)])) -> ((Int, Int) -> Maybe Vertex) -> Vertex -> Vertex -> Int
+paths graph gfunc gfunc2 x y
+  | x == y               = 1
+  | not $ path graph x y = 0
+  | otherwise            =  sum . map (\x -> paths graph gfunc gfunc2 x y) . map (fromJust . gfunc2) . (\(a, b, c) -> c) $ gfunc x
+
+verticesWhereEq :: Graph -> (Vertex -> (Int, (Int, Int), [(Int, Int)])) -> Int -> [Vertex]
+verticesWhereEq graph gfunc x = filter (\v -> let (a, _, _) = gfunc v in a == x) . vertices $ graph
+
+main :: IO()
+main = do
+       fileinp <- readFile "input.txt"
+       let parsed = splitInput fileinp
+       let (graph, gfunc, gfunc2) = makeGraph parsed
+       let solved1 = solve1 graph gfunc
+       let solved2 = solve2 graph gfunc gfunc2
+       print solved1
+       print solved2